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