CTITLESAOMNB -- REVERSE NMOC ARRAY PROCESSOR CODE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00020000 CA DESIGNER PAM COOPER, DANIEL POLAK, STU NELAN 00030000 CA LANGUAGE VPSS -FORTRAN 00040000 CA SYSTEM S/370 00050000 CA WRITTEN 03-01-82 00060000 C REVISED 03-26-82 JBC. ADDED VPSS CALL TO RETURN 00070000 C CORRECTED VELOCITY 00080000 C REVISED 04-26-82 ESN. CORRECTED PROBLEMS IN OMN CODE. 00090000 C REVISED 05-15-85 RDK. ADDED DUMMY ENTRY UPOMNB FOR CRAY. 00100000 C REVISED 07-14-86 ESN. REMOVE DUMMY ENTRY UPOMNB. 00110000 CA 00120000 CA CALL SAOMNB (APUNIT, APLEN, NOSAMP, CCW, LCCW, CIT, LCIT, APINDX, 00130000 CA DNMO, VELTAB, TRACE, REJECT, APOMNB) 00140000 CA 00150000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00160000 CA 00170000 CA IN APUNIT I4 IBM ARRAY PROCESSOR UNIT NUMBER 00180000 CA IN APLEN I4 NUMBER OF WORDS TO PASS TO THE AP3838 00190000 CA IN NOSAMP I4 NUMBER OF SAMPLES IN TRACE 00200000 CA IN/OUT CCW I4 CCW TABLE 00210000 CA IN LCCW I4 LENGTH OF CCW TABLE 00220000 CA IN/OUT CIT I4 CIT TABLE 00230000 CA IN LCIT I4 LENGTH OF CIT TABLE 00240000 CA IN APINDX R4,I4 PARAMETERS TO PASS TO AP3838 00250000 CA IN DNMO I4 DIFFERENTIAL REVERSE NORMAL MOVEOUT FLAG 00260000 CA 0 = NO DNMO 00270000 CA 1 = APPLY DNMO 00280000 CA IN VELTAB R4 VELOCITY FUNCTION 00290000 CA IN/OUT TRACE R4 SEISMIC TRACE 00300000 CA OUT REJECT R4 INDICATOR OF SAMPLES TO ACCEPT/REJECT 00310000 CA OUT APOMNB I4 ADDRESS OF TRANSLATE TABLE 00320000 CA 00330000 CA 00340000 CA THIS SUBROUTINE CONTAINS THE 3838 ARRAY PROCESSOR CALLS USED 00350000 CA BY SDNMOC TO PERFORM REVERSE NORMAL MOVEOUT. 00360000 CA 00370000 CA EJECT 00380000 C 00390000 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 00400000 C 00410000 C NAME TYPE DESCRIPTION 00420000 C 00430000 C APDISI I4 ADDRESS IN BULK STORAGE OF TRACE DISTANCE 00440000 C APDISO I4 ADDRESS OF DISTANCE FOR DIFFERENTIAL MOVEOUT 00450000 C APFIX I4 ADDRESS OF CONTROL PARAMETERS FOR 'VFX' 00460000 C APINTI I4 ADDRESS OF 'INT' PARAMETERS 00470000 C APINTP I4 ADDRESS OF 'INT' WORK PARAMETERS 00480000 C APLIMT I4 ADDRESS OF 4 WORD WORD ARRAY, USED IN 'LIM' 00490000 C APNSI I4 ADDRESS OF NUMBER OF SAMPLES 00500000 C APONE I4 ADDRESS OF FLOATING POINT ONE 00510000 C APRLEN I4 ADDRESS OF RECORD LENGTH IN SECONDS 00520000 C APSAMP I4 ADDRESS OF SAMPLE RATE IN SECONDS 00530000 C APSLEN I4 ADDRESS OF FIVE SECTION LENGTH LIMITS CAUSED BY INT 00540000 C APTRAZ I4 ADDRESS OF INPUT TRACE (AND OUTPUT) 00550000 C APTZRO I4 ADDRESS OF TIME ZERO ARRAY (IN SAMPLES) 00560000 C APTZR2 I4 ADDRESS OF TIME ZERO SQUARED ARRAY 00570000 C APVELI I4 ADDRESS OF VELOCTY FUNCTION 00580000 C APWORK I4 ADDRESS OF WORK ARRAY 00590000 C APWRK2 I4 ADDRESS OF WORK ARRAY 00600000 C 00610000 C INDEX REGISTERS 00620000 C 00630000 C REG 1 NOSAMP 00640000 C REG 2 WORK INDEX = 1 00650000 C REG 3 WORK INDEX = 3 00660000 C REG 4 NUMBER OF SAMPLES TO INTERPOLATE AT ONE TIME 00670000 C REG 5 INDEX OF TIME TRACE FOR START OF INTERPOLATION 00680000 C REG 6 TOTAL NUMBER OF SAMPLES INTERPOLATED 00690000 C REG 7 LENGTH OF SECTION OF INPUT TRACE PROCESSED 00700000 C REG 8 INDEX INTO INPUT TRACE 00710000 C REG 9 NUMBER OF SAMPLES LEFT TO PROCESS 00720000 C REG 10 SECTION NUMBER 00730000 C REG 11 NOSAMP - 1 00740000 C REG 12 2 * NOSAMP 00750000 C REG 13 NOT USED 00760000 C REG 14 NOT USED 00770000 C REG 15 DEBUG USE 00780000 CD 00790000 CD FLOWCHART FOR APPLYING REVERSE NORMAL MOVEOUT IN 3838 00800000 CD ===================================================== 00810000 CD 00820000 CD 1 COMPUTE T0 ** 2 WHERE T0 IS TIME ZERO. 00830000 CD 00840000 CD 2 COMPUTE X / V WHERE X IS THE SHOTPOINT TO TRACE 00850000 CD DISTANCE AND V IS THE VELOCITY FUNCTION. 00860000 CD 00870000 CD 3 COMPUTE (X / V) ** 2 00880000 CD 00890000 CD 4 COMPUTE T0 ** 2 + (X / V) ** 2 00900000 CD 00910000 CD 5 COMPUTE TX = (T0 ** 2 + (X / V) ** 2) ** 0.5 00920000 CD 00930000 CD 6 LINEARLY INTERPOLATE TX TO INTEGER SAMPLES 00940000 CD 00950000 CD 7 APPLY REVERSE NMO VIA QUADRATIC INTERPOLATION. 00960000 CD 00970000 CD ======================================================= 00980000 CD 00990000 CD FLOWCHART FOR ADJUSTING THE VELOCITIES FOR APPLYING 01000000 CD DIFFERENTIAL REVERSE NORMAL MOVEOUT 01010000 CD 01020000 CD A COMPUTE MOVEOUT FOR THE INPUT DISTANCE 01030000 CD TXIN = (T0 ** 2 + (XIN / V) ** 2) ** 0.5 01040000 CD 01050000 CD B COMPUTE MOVEOUT FOR THE OUTPUT DISTANCE 01060000 CD TXOUT = (T0 ** 2 + (XOUT / V) ** 2) ** 0.5 01070000 CD 01080000 CD C COMPUTE THE DIFFERENTIAL MOVEOUT 01090000 CD DTX = ABS(TXIN - TXOUT) 01100000 CD 01110000 CD D ADJUST THE VELOCITIES 01120000 CD V = XIN / ((DTX * (DTX + (2.0 * T0))) ** 0.5) 01130000 CD 01140000 CD ======================================================= 01150000 C 01160000 SUBROUTINE SAOMNB (APUNIT, APLEN, NOSAMP, CCW, LCCW, CIT, LCIT, 01170000 * APINDX, DNMO, VELTAB, TRACE, REJECT, APOMNB) 01180000 C 01190000 IMPLICIT INTEGER (A-Z) 01200000 C 01210000 C ARRAYS -- IN PARAMETER LIST 01220000 C 01230000 INTEGER CCW (LCCW) 01240000 REAL APINDX (1) 01250000 REAL CIT (LCIT) 01260000 REAL REJECT (1) 01270000 REAL TRACE (1) 01280000 REAL VELTAB (1) 01290000 C 01300000 C INTEGER CONSTANTS -- LOCAL 01310000 C 01320000 INTEGER R1 /1/ 01330000 INTEGER R2 /2/ 01340000 INTEGER R3 /3/ 01350000 INTEGER R4 /4/ 01360000 INTEGER R5 /5/ 01370000 INTEGER R6 /6/ 01380000 INTEGER R7 /7/ 01390000 INTEGER R8 /8/ 01400000 INTEGER R9 /9/ 01410000 INTEGER R10 /10/ 01420000 INTEGER R11 /11/ 01430000 INTEGER R12 /12/ 01440000 INTEGER R15 /15/ 01450000 C 01460000 C CREATE 3838 BULK STORAGE ADDRESSES 01470000 C 01480000 APDISI = 1 01490000 APDISO = APDISI + 1 01500000 APNSI = APDISO + 1 01510000 APFIX = APNSI + 1 01520000 APRLEN = APFIX + 2 01530000 APONE = APRLEN + 2 01540000 APSLEN = APONE + 1 01550000 APSAMP = APSLEN + 5 01560000 APINTI = APSAMP + 1 01570000 APTZRO = APINTI + 7 01580000 APTRAZ = APTZRO + NOSAMP 01590000 APVELI = APTRAZ + NOSAMP + 4 01600000 APTZR2 = APVELI + NOSAMP 01610000 APINTP = APTZR2 + NOSAMP 01620000 APWORK = APINTP + 3 01630000 APWRK2 = APWORK + NOSAMP 01640000 APLIMT = APWRK2 + NOSAMP 01650000 C 01660000 C BUILD THE 3838 TASK 01670000 C 01680000 CALL VPSS (APUNIT, 'BLD ', 7, CCW, LCCW, CIT, LCIT) 01690000 C 01700000 C MOVE DATA TO ARRAY PROCESSOR 01710000 C 01720000 CALL VPSS (APUNIT, 'VPUT', APINDX, APLEN, 1, 0) 01730000 CALL VPSS (APUNIT, 'VPUT', TRACE, NOSAMP, APTRAZ, 0) 01740000 CALL VPSS (APUNIT, 'VPUT', VELTAB, NOSAMP, APVELI, 0) 01750000 C 01760000 C INITIALIZE SOME INDEX REGISTERS 01770000 C 01780000 CALL VPSS (APUNIT, 'XMVS', APNSI, 1, 0, R1) 01790000 CALL VPSS (APUNIT, 'XMV ', R11, R1) 01800000 CALL VPSS (APUNIT, 'XSBI', R11, 1) 01810000 CALL VPSS (APUNIT, 'XMV ', R12, R1) 01820000 CALL VPSS (APUNIT, 'XAD ', R12, R12) 01830000 CALL VPSS (APUNIT, 'XMVI', R2, 1) 01840000 CALL VPSS (APUNIT, 'XMVI', R3, 3) 01850000 CALL VPSS (APUNIT, 'XMVI', R15, 10) 01860000 C 01870000 C CONVERT FROM TIME TO SAMPLES 01880000 C 01890000 CALL VPSS (APUNIT, 'SMY ', 0, 01900000 * 64, APVELI, 0, 1, R1, 01910000 * 0, APVELI, 1, 01920000 * 0, APSAMP) 01930000 C 01940000 C COMPUTE T0 ** 2 01950000 C 01960000 CALL VPSS (APUNIT, 'SSA ', 0, 01970000 * 64, APTZR2, 0, 1, R1, 01980000 * 0, APTZRO) 01990000 C 02000000 C CHECK FOR DIFFERENTIAL REVERSE NORMAL MOVEOUT 02010000 C 02020000 IF (DNMO .EQ. 0) GO TO 10 02030000 C 02040000 C NEED TO ADJUST THE VELOCITIES IN ORDER TO PERFORM DIFFERENTIAL 02050000 C REVERSE NORMAL MOVEOUT 02060000 C 02070000 CALL VPSS (APUNIT, 'XMVI', R15, 11) 02080000 C 02090000 C COMPUTE XIN / V 02100000 C 02110000 CALL VPSS (APUNIT, 'SDIV', 8, 02120000 * 64, APWORK, 0, 1, R1, 02130000 * 0, APVELI, 1, 02140000 * 0, APDISI) 02150000 C 02160000 C COMPUTE XOUT / V 02170000 C 02180000 CALL VPSS (APUNIT, 'SDIV', 8, 02190000 * 64, APWRK2, 0, 1, R1, 02200000 * 0, APVELI, 1, 02210000 * 0, APDISO) 02220000 C 02230000 C COMPUTE (XIN / V) ** 2 02240000 C 02250000 CALL VPSS (APUNIT, 'SSA ', 0, 02260000 * 64, APWORK, 0, 1, R1, 02270000 * 0, APWORK) 02280000 C 02290000 C COMPUTE (XOUT / V) ** 2 02300000 C 02310000 CALL VPSS (APUNIT, 'SSA ', 0, 02320000 * 64, APWRK2, 0, 1, R1, 02330000 * 0, APWRK2) 02340000 C 02350000 C COMPUTE T0 ** 2 + (XIN / V) ** 2 02360000 C 02370000 CALL VPSS (APUNIT, 'VES ', 0, 02380000 * 64, APVELI, 0, 1, R1, 02390000 * 0, APWORK, 1, 02400000 * 0, APTZR2) 02410000 C 02420000 C COMPUTE TXIN = (T0 ** 2 + (XIN / V) ** 2) ** 0.5 02430000 C 02440000 CALL VPSS (APUNIT, 'SQRT', 0, 02450000 * 64, APWORK, 0, 1, R1, 02460000 * 0, APVELI) 02470000 C 02480000 C COMPUTE T0 ** 2 + (XOUT / V) ** 2 02490000 C 02500000 CALL VPSS (APUNIT, 'VES ', 0, 02510000 * 64, APVELI, 0, 1, R1, 02520000 * 0, APWRK2, 1, 02530000 * 0, APTZR2) 02540000 C 02550000 C COMPUTE TXOUT = (T0 ** 2 + (XOUT / V) ** 2) ** 0.5 02560000 C 02570000 CALL VPSS (APUNIT, 'SQRT', 0, 02580000 * 64, APWRK2, 0, 1, R1, 02590000 * 0, APVELI) 02600000 C 02610000 C COMPUTE DTX = ABS(TXIN - TXOUT) 02620000 C 02630000 CALL VPSS (APUNIT, 'VES ', 0, 02640000 * 64, APWRK2, 0, 1, R1, 02650000 * 0, APWORK, 1, 02660000 * 8, APWRK2) 02670000 C 02680000 CALL VPSS (APUNIT, 'VMV ', 0, 02690000 * 64, APWORK, 0, 1, R1, 02700000 * 4, APWRK2) 02710000 C 02720000 C USE THE DIFFERENTIAL MOVEOUT TO ADJUST THE VELOCITIES 02730000 C 02740000 C COMPUTE 2.0 * T0 02750000 C 02760000 CALL VPSS (APUNIT, 'VES ', 0, 02770000 * 64, APWRK2, 0, 1, R1, 02780000 * 0, APTZRO, 1, 02790000 * 0, APTZRO) 02800000 C 02810000 C COMPUTE DTX + (2.0 * T0) 02820000 C 02830000 CALL VPSS (APUNIT, 'VES ', 0, 02840000 * 64, APWRK2, 0, 1, R1, 02850000 * 0, APWRK2, 1, 02860000 * 0, APWORK) 02870000 C 02880000 C COMPUTE DTX * (DTX + (2.0 * T0)) 02890000 C 02900000 CALL VPSS (APUNIT, 'VEM ', 0, 02910000 * 64, APWRK2, 0, 1, R1, 02920000 * 0, APWRK2, 1, 02930000 * 0, APWORK) 02940000 C 02950000 C COMPUTE (DTX * (DTX + (2.0 * T0))) ** 0.5 02960000 C 02970000 CALL VPSS (APUNIT, 'SQRT', 0, 02980000 * 64, APWORK, 0, 1, R1, 02990000 * 0, APWRK2) 03000000 C 03010000 C ADJUST THE VELOCITIES 03020000 C 03030000 CALL VPSS (APUNIT, 'SDIV', 8, 03040000 * 64, APVELI, 0, 1, R1, 03050000 * 0, APWORK, 1, 03060000 * 0, APDISI) 03070000 CALL VPSS (APUNIT, 'VGET', TRACE, NOSAMP, APVELI, 0) 03080000 C 03090000 C***********************************************************************03100000 C *03110000 C END OF VELOCITY ADJUSTMENT SECTION *03120000 C *03130000 C***********************************************************************03140000 C *03150000 C REVERSE NORMAL MOVEOUT APPLICATION SECTION *03160000 C *03170000 C***********************************************************************03180000 C 03190000 C FIND THE INTERPOLATION POINTS 03200000 C 03210000 10 CALL VPSS (APUNIT, 'XMVI', R15, 12) 03220000 C 03230000 C COMPUTE X / V 03240000 C 03250000 CALL VPSS (APUNIT, 'SDIV', 8, 03260000 * 64, APVELI, 0, 1, R1, 03270000 * 0, APVELI, 1, 03280000 * 0, APDISI) 03290000 C 03300000 C COMPUTE (X / V) ** 2 03310000 C 03320000 CALL VPSS (APUNIT, 'SSA ', 0, 03330000 * 64, APVELI, 0, 1, R1, 03340000 * 0, APVELI) 03350000 C 03360000 C COMPUTE T0 ** 2 + (X / V) ** 2 03370000 C 03380000 CALL VPSS (APUNIT, 'VES ', 0, 03390000 * 64, APWORK, 0, 1, R1, 03400000 * 0, APVELI, 1, 03410000 * 0, APTZR2) 03420000 C 03430000 C COMPUTE TX = (T0 ** 2 + (X / V) ** 2) ** 0.5 03440000 C 03450000 CALL VPSS (APUNIT, 'SQRT', 0, 03460000 * 64, APVELI, 0, 1, R1, 03470000 * 0, APWORK) 03480000 C 03490000 CALL VPSS (APUNIT, 'SSUM', 0, 03500000 * 64, APVELI, 0, 1, R1, 03510000 * 0, APVELI, 1, 03520000 * 0, APONE) 03530000 C 03540000 C#######################################################################03550000 C #03560000 C PERFORM LINEAR INTERPOLATION TO OBTAIN THE INTERPOLATION POINTS #03570000 C #03580000 C#######################################################################03590000 C 03600000 C TRUNCATE TO INTEGER 03610000 C 03620000 CALL VPSS (APUNIT, 'VFX ', 0, 03630000 * 66, APWRK2, 0, R12, 03640000 * 0, APVELI, 1, 03650000 * 0, APFIX) 03660000 C 03670000 CALL VPSS (APUNIT, 'VMC ', 0, 03680000 * 64, APWORK, 0, 1, R12, 03690000 * 2, APWRK2) 03700000 C 03710000 C FIND DIFFERENCES BETWEEN COMPUTED MOVEOUT POINTS IN TX 03720000 C (DENOMINATOR) 03730000 C 03740000 CALL VPSS (APUNIT, 'VES ', 0, 03750000 * 64, APWRK2, 0, 1, R11, 03760000 * 32, APVELI, 1, R2, 03770000 * 8, APVELI) 03780000 C 03790000 C FIND DIFFERENCES BETWEEN COMPUTED POINTS IN TX AND NEXT LOWER 03800000 C SAMPLE OF TX (NUMERATOR) 03810000 C 03820000 CALL VPSS (APUNIT, 'VES ', 0, 03830000 * 64, APTZR2, 0, 1, R11, 03840000 * 32, APWORK, 1, R2, 03850000 * 8, APVELI) 03860000 C 03870000 C LAST SAMPLE IS A SPECIAL CASE 03880000 C 03890000 CALL VPSS (APUNIT, 'SMV ', 0, 03900000 * 32, APWRK2, 1, 1, R11, 03910000 * 0, APONE) 03920000 C 03930000 CALL VPSS (APUNIT, 'SMV ', 0, 03940000 * 32, APTZR2, 1, 1, R11, 03950000 * 0, APINTI) 03960000 C 03970000 C FIND FRACTIONAL PART OF A SAMPLE 03980000 C 03990000 CALL VPSS (APUNIT, 'DIV ', 0, 04000000 * 64, APWORK, 0, 1, R1, 04010000 * 0, APWRK2, 1, 04020000 * 0, APTZR2) 04030000 C 04040000 C COMPUTE THE INTERPOLATION POINTS 04050000 C 04060000 CALL VPSS (APUNIT, 'VES ', 0, 04070000 * 96, APWORK, 0, 1, R2, R11, 04080000 * 32, APWORK, 1, R2, 04090000 * 0, APTZRO) 04100000 C 04110000 CALL VPSS (APUNIT, 'SSUM', 0, 04120000 * 96, APWORK, 0, 1, R2, R11, 04130000 * 32, APWORK, 1, R2, 04140000 * 0, APONE) 04150000 C 04160000 C#######################################################################04170000 C #04180000 C LINEAR INTERPOLATION TO OBTAIN THE INTERPOLATION POINTS COMPLETE #04190000 C NOW DO THE QUADRATIC INTERPOLATION OF THE ZERO OFFSET TRACE #04200000 C #04210000 C#######################################################################04220000 C 04230000 C ZERO OUTPUT ARRAY 04240000 C 04250000 CALL VPSS (APUNIT, 'ZMV ', 0, 04260000 * 64, APVELI, 0, 1, R1) 04270000 C 04280000 C ZERO INT PARAMETERS TO AVOID UNDERFLOW 04290000 C 04300000 CALL VPSS (APUNIT, 'ZMV ', 0, 04310000 * 0, APINTP, 4) 04320000 C 04330000 C ZERO FIRST TWO WORDS AND FOUR WORDS PAST END OF INPUT TRACE 04340000 C 04350000 CALL VPSS (APUNIT, 'ZMV ', 0, 04360000 * 0, APTRAZ, 2, 1) 04370000 C 04380000 CALL VPSS (APUNIT, 'ZMV ', 0, 04390000 * 32, APTRAZ, 4, 1, R1) 04400000 C 04410000 C MOVE LOWER LIMITS INTO APLIMT 04420000 C 04430000 CALL VPSS (APUNIT, 'SMV ', 0, 04440000 * 0, APLIMT, 4, 1, 04450000 * 0, APONE) 04460000 C 04470000 C MOVE UPPER LIMITS INTO APLIMT 04480000 C 04490000 CALL VPSS (APUNIT, 'VMV ', 0, 04500000 * 0, APLIMT, 2, 1, 04510000 * 0, APRLEN) 04520000 C 04530000 C MAKE SURE DON'T INTERPOLATE TOO FAR 04540000 C 04550000 CALL VPSS (APUNIT, 'LIM ', 0, 04560000 * 64, APWORK, 0, 1, R1, 04570000 * 0, APWORK, 1, 04580000 * 0, APLIMT) 04590000 C 04600000 C STEP 7 INTERPOLATION 04610000 C 04620000 C SET UP INDICES IF MORE THAN 3995 SAMPLES 04630000 C 04640000 CALL VPSS (APUNIT, 'XMVI', R5, 0) 04650000 C 04660000 CALL VPSS (APUNIT, 'XMVI', R6, 0) 04670000 C 04680000 CALL VPSS (APUNIT, 'XMVI', R7, 3995) 04690000 C 04700000 CALL VPSS (APUNIT, 'XMVI', R8, 0) 04710000 C 04720000 CALL VPSS (APUNIT, 'XMVI', R10, 0) 04730000 C 04740000 CALL VPSS (APUNIT, 'XMVI', R15, 0) 04750000 C 04760000 C TEST IF MORE THAN 3995 SAMPLES 04770000 C 04780000 CALL VPSS (APUNIT, 'XCI ', R1, 3995, 'GT39', 'GT ') 04790000 C 04800000 C IF NOT SET UP APPROPRIATE REGISTERS 04810000 C 04820000 CALL VPSS (APUNIT, 'XMV ', R4, R1) 04830000 C 04840000 CALL VPSS (APUNIT, 'XMV ', R6, R1) 04850000 C 04860000 CALL VPSS (APUNIT, 'XMV ', R7, R1) 04870000 C 04880000 CALL VPSS (APUNIT, 'SMV ', 0, 04890000 * 64, APWRK2, 0, 1, R1, 04900000 * 0, APONE) 04910000 C 04920000 CALL VPSS (APUNIT, 'XGO ', 'INTP') 04930000 C 04940000 C COME HERE IF MORE THAN 3995 SAMPLES 04950000 C 04960000 CALL VPSS (APUNIT, 'XID ', 'GT39') 04970000 C 04980000 CALL VPSS (APUNIT, 'XADI', R15, 1) 04990000 C 05000000 C REGISTER 9 IS THE NUMBER OF SAMPLES LEFT TO PROCESS 05010000 C 05020000 CALL VPSS (APUNIT, 'XMV ', R9, R1) 05030000 C 05040000 CALL VPSS (APUNIT, 'XSB ', R9, R6) 05050000 C 05060000 C MOVE TOTAL NUMBER DONE SO FAR TO REG 5 TO 05070000 C USE AS AN INDEX INTO THE COMPUTED TIMES ARRAY 05080000 C 05090000 CALL VPSS (APUNIT, 'XMV ', R5, R6) 05100000 C 05110000 C ZERO WORK AREAS 05120000 C 05130000 CALL VPSS (APUNIT, 'ZMV ', 0, 05140000 * 64, APWRK2, 4, 1, R1) 05150000 C 05160000 C MAKE UPPER AND LOWER LIMIT EQUAL TO END SAMPLE OF SECTION 05170000 C 05180000 CALL VPSS (APUNIT, 'SMV ', 0, 05190000 * 0, APLIMT, 3, 1, 05200000 * 32, APSLEN, R10) 05210000 C 05220000 C MAKE SECOND 'LIM' PARAMETER EQUAL TO ONE 05230000 C 05240000 CALL VPSS (APUNIT, 'SMV ', 0, 05250000 * 32, APLIMT, 1, 1, R2, 05260000 * 0, APONE) 05270000 C 05280000 C FIND SAMPLES PAST END OF SECTION 05290000 C 05300000 CALL VPSS (APUNIT, 'LIM ', 0, 05310000 * 96, APWRK2, 0, 1, R5, R9, 05320000 * 32, APWORK, 1, R5, 05330000 * 0, APLIMT) 05340000 C 05350000 C FIND FIRST SAMPLE PAST END OF SECTION 05360000 C 05370000 CALL VPSS (APUNIT, 'MAX ', 0, 05380000 * 0, APLIMT, 05390000 * 96, APWRK2, 0, 1, R5, R9) 05400000 C 05410000 C MOVE NUMBER TO DO INTO REG 4 05420000 C 05430000 CALL VPSS (APUNIT, 'XMVS', APLIMT, 1, R2, R4) 05440000 C 05450000 C TEST IF NUMBER TO DO IS GREATER THAN NUMBER LEFT 05460000 C 05470000 CALL VPSS (APUNIT, 'XC ', R4, R9, 'GTNL', 'GT ') 05480000 C 05490000 C TEST IF NUMBER TO DO IS GREATER THAN ZERO 05500000 C 05510000 CALL VPSS (APUNIT, 'XCI ', R4, 0, 'FOUN', 'GT ') 05520000 C 05530000 C REG 4 < = ZERO OR REG 4 > NUMBER LEFT TO PROCESS 05540000 C 05550000 CALL VPSS (APUNIT, 'XID ', 'GTNL') 05560000 C 05570000 C MOVE NUMBER LEFT TO PROCESS TO REG 4 05580000 C 05590000 CALL VPSS (APUNIT, 'XMV ', R4, R9) 05600000 C 05610000 C CONTINUE WITH PROCESSING 05620000 C 05630000 CALL VPSS (APUNIT, 'XID ', 'FOUN') 05640000 C 05650000 C COMPUTE NEW TOTAL DONE 05660000 C 05670000 CALL VPSS (APUNIT, 'XAD ', R6, R4) 05680000 C 05690000 C MOVE LOWER INPUT SAMPLE LIMIT TO APLIMT 05700000 C 05710000 CALL VPSS (APUNIT, 'XMVX', APLIMT, 1, 0, R8) 05720000 C 05730000 C CONVERT TO FLOATING POINT 05740000 C 05750000 CALL VPSS (APUNIT, 'VMC ', 0, 05760000 * 0, APWRK2, 2, 1, 05770000 * 2, APLIMT) 05780000 C 05790000 C CORRECT DISPLACEMENT TO TIME ZERO (NEGATIVE) 05800000 C 05810000 CALL VPSS (APUNIT, 'VMV ', 0, 05820000 * 0, APINTI, 1, 1, 05830000 * 48, APWRK2, 1, R2) 05840000 C 05850000 C MOVE TO FIRST THREE 'LIM' PARAMETERS 05860000 C 05870000 CALL VPSS (APUNIT, 'SMV ', 0, 05880000 * 0, APLIMT, 3, 1, 05890000 * 32, APWRK2, R2) 05900000 C 05910000 C MOVE ONE TO SECOND 'LIM' PARAMETER 05920000 C 05930000 CALL VPSS (APUNIT, 'SMV ', 0, 05940000 * 32, APLIMT, 1, 1, R2, 05950000 * 0, APONE) 05960000 C 05970000 C MOVE ZERO TO FOURTH 'LIM' PARAMETER 05980000 C 05990000 CALL VPSS (APUNIT, 'ZMV ', 0, 06000000 * 32, APLIMT, 1, 1, R3) 06010000 C 06020000 C CHECK IF ANY SAMPLES BELOW LOWER SAMPLE LIMIT 06030000 C 06040000 CALL VPSS (APUNIT, 'LIM ', 0, 06050000 * 96, APWRK2, 0, 1, R5, R4, 06060000 * 32, APWORK, 1, R5, 06070000 * 0, APLIMT) 06080000 C 06090000 C COME HERE TO DO ACTUAL INTERPOLATION 06100000 C 06110000 CALL VPSS (APUNIT, 'XID ', 'INTP') 06120000 C 06130000 C MOVE 3 SAMPLES SO DON'T GET DESTROYED 06140000 C 06150000 CALL VPSS (APUNIT, 'VMV ', 0, 06160000 * 0, APLIMT, 3, 1, 06170000 * 32, APINTP, 1, R5) 06180000 C 06190000 C MOVE INT PARAMETERS INTO CORRECT AREA 06200000 C 06210000 CALL VPSS (APUNIT, 'VMV ', 0, 06220000 * 32, APINTP, 3, 1, R5, 06230000 * 0, APINTI) 06240000 C 06250000 C DO QUADRATIC INTERPOLATION 06260000 C 06270000 CALL VPSS (APUNIT, 'INT ', 0, 06280000 * 96, APVELI, 0, 1, R5, R4, 06290000 * 96, APTRAZ, 4, 1, R8, R7, 06300000 * 96, APINTP, 3, 1, R5, R4) 06310000 C 06320000 C REPLACE 3 SAMPLES 06330000 C 06340000 CALL VPSS (APUNIT, 'VMV ', 0, 06350000 * 32, APINTP, 3, 1, R5, 06360000 * 0, APLIMT) 06370000 C 06380000 C COMPENSATE FOR VALUES POINTING ABOVE THE SECTION 06390000 C 06400000 CALL VPSS (APUNIT, 'VEM ', 0, 06410000 * 96, APVELI, 0, 1, R5, R4, 06420000 * 32, APVELI, 1, R5, 06430000 * 32, APWRK2, 1, R5) 06440000 C 06450000 C INCREMENT TRACE INDEX 06460000 C 06470000 CALL VPSS (APUNIT, 'XAD ', R8, R7) 06480000 C 06490000 C ALLOW FOR TWO SAMPLE OVERLAP 06500000 C 06510000 CALL VPSS (APUNIT, 'XSBI', R8, 2) 06520000 C 06530000 C INCREMENT SECTION NUMBER 06540000 C 06550000 CALL VPSS (APUNIT, 'XADI', R10, 1) 06560000 C 06570000 C CHECK IF THROUGH WITH TRACE 06580000 C 06590000 CALL VPSS (APUNIT, 'XC ', R6, R1, 'GT39', 'LT ') 06600000 C 06610000 C TRANSFER DATA BACK TO 370 06620000 C 06630000 CALL VPSS (APUNIT, 'VGET', TRACE, NOSAMP, APVELI, 0) 06640000 CALL VPSS (APUNIT, 'VGET', REJECT, NOSAMP, APTZR2, 0) 06650000 C 06660000 C TRANSLATE THE COMMANDS 06670000 C 06680000 CALL VPSS (APUNIT, 'XLTE', APOMNB) 06690000 C 06700000 RETURN 06710000 C 06720000 END 06730000