CTITLESANMOI -- NMOC ARRAY PROCESSOR CODE 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR PAM COOPER 00000020 CA DESIGNER PAM COOPER 00000030 CA LANGUAGE S/370 VPSS -FORTRAN 00000040 CA WRITTEN 06-05-78 00000050 C REVISED 04-21-80 COOPER - CHANGED BLD ISTATE TO 3, SO WILL 00000060 C PAGE FIX AT EXECTION TIME. 00000070 C REVISED 02-22-82 POLAK - CHANGED BLD ISTATE TO 7 FOR CCW RETRANS-00000080 C LATION AND ADDED THE VELOCITY ADJUSTMENT SEC- 00000090 C TION FOR DIFFERENTIAL MOVEOUT APPLICATION. 00000100 C ALSO MADE THE CCW AN INTEGER ARRAY. 00000110 C REVISED 03-30-82 NELAN - MODIFIED THE DNMO CODE. 00000120 C REVISED 05-06-82 NELAN - ADDED IN A STATIC CAPABILITY 00000130 CA 00000140 CA 00000150 CA CALL SANMOI (APUNIT, APLEN, APDNMO, APNMOC, NOSAMP, CCW1, LCCW1, 00000160 CA CIT1, LCIT1, CCW2, LCCW2, CIT2, LCIT2, APINDX, 00000170 CA DNMO, VELTAB, TRACE) 00000180 CA 00000190 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00000200 CA 00000210 CA INPUT APUNIT I4 IBM ARRAY PROCESSOR UNIT NUMBER 00000220 CA INPUT APLEN I4 NUMBER OF WORDS TO PASS TO THE AP3838 00000230 CA OUTPUT APDNMO I4 ADDRESS OF TRANSLATE TABLE FOR DNMO 00000240 CA OUTPUT APNMOC I4 ADDRESS OF TRANSLATE TABLE FOR NMOC 00000250 CA INPUT NOSAMP I4 NUMBER OF SAMPLES IN TRACE 00000260 CA IN/OUT CCW1 I4 CCW1 TABLE 00000270 CA INPUT LCCW1 I4 LENGTH OF THE CCW1 TABLE 00000280 CA IN/OUT CIT1 R4 CIT1 TABLE 00000290 CA INPUT LCIT1 I4 LENGTH OF THE CIT1 TABLE 00000300 CA IN/OUT CCW2 I4 CCW2 TABLE 00000310 CA INPUT LCCW2 I4 LENGTH OF THE CCW2 TABLE 00000320 CA IN/OUT CIT2 R4 CIT2 TABLE 00000330 CA INPUT LCIT2 I4 LENGTH OF THE CIT2 TABLE 00000340 CA INPUT APINDX R4,I4 WORDS TO PASS TO AP3838 00000350 CA INPUT DNMO I4 DIFFERENTIAL NORMAL MOVEOUT FLAG 00000360 CA 0 = NO DNMO 00000370 CA 1 = APPLY DNMO 00000380 CA INPUT VELTAB R4 VELOCITY FUNCTION 00000390 CA IN/OUT TRACE R4 SEISMIC TRACE 00000400 CA 00000410 CA 00000420 CA THIS SUBROUTINE CONTAINS THE 3838 ARRAY PROCESSOR CALLS USED 00000430 CA BY SDNMOC TO PERFORM DIFFERENTIAL NORMAL MOVEOUT. 00000440 CA 00000450 C EJECT IF ABSTRACTS NEEDS A PAGE EJECT PUT 'A' IN COLUMN 2. 00000460 C 00000470 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 00000480 C 00000490 C NAME TYPE DESCRIPTION 00000500 C 00000510 C APDISI I4 ADDRESS IN BULK STORAGE OF TRACE DISTANCE 00000520 C APDISO I4 ADDRESS OF DISTANCE FOR DIFFERENTIAL MOVEOUT 00000530 C APSTAT I4 ADDRESS OF STATIC 00000540 C APINTI I4 ADDRESS OF 'INT' PARAMETERS 00000550 C APINTP I4 ADDRESS OF 'INT' WORK PARAMETERS 00000560 C APLIMT I4 ADDRESS OF 4 WORD WORD ARRAY, USED IN 'LIM' 00000570 C APMTFL I4 ADDRESS OF MUTE FLAG 00000580 C APMUTE I4 ADDRESS OF MUTING LIMIT 00000590 C APNSI I4 ADDRESS OF NUMBER OF SAMPLES 00000600 C APONE I4 ADDRESS OF FLOATING POINT ONE 00000610 C APRLEN I4 ADDRESS OF RECORD LENGTH IN SECONDS 00000620 C APSAMP I4 ADDRESS OF SAMPLE RATE IN SECONDS 00000630 C APSLEN I4 ADDRESS OF FIVE SECTION LENGTH LIMITS CAUSED BY INT 00000640 C APTRAZ I4 ADDRESS OF INPUT TRACE (AND OUTPUT) 00000650 C APTZRO I4 ADDRESS OF TIME ZERO ARRAY (SAMPLE TIME IN SECONDS) 00000660 C APTZR2 I4 ADDRESS OF TIME ZERO SQUARED ARRAY 00000670 C APVELI I4 ADDRESS OF VELOCTY FUNCTION 00000680 C APWORK I4 ADDRESS OF WORK ARRAY 00000690 C APWRK2 I4 ADDRESS OF WORK ARRAY 00000700 C 00000710 C R1 - R14 SEE REGISTER CONTENT COMMENTS BELOW 00000720 C 00000730 SUBROUTINE SANMOI (APUNIT, APLEN, APDNMO, APNMOC, NOSAMP, CCW1, 00000740 * LCCW1, CIT1, LCIT1, CCW2, LCCW2, CIT2, LCIT2, 00000750 * APINDX, DNMO, VELTAB, TRACE) 00000760 C 00000770 IMPLICIT INTEGER (A-Z) 00000780 C 00000790 C ARRAYS -- IN PARAMETER LIST 00000800 C 00000810 INTEGER CCW1 (LCCW1) 00000820 REAL CIT1 (LCIT1) 00000830 INTEGER CCW2 (LCCW2) 00000840 REAL CIT2 (LCIT2) 00000850 REAL APINDX (1) 00000860 REAL VELTAB (1) 00000870 REAL TRACE (1) 00000880 C 00000890 C INTEGER CONSTANTS -- LOCAL 00000900 C 00000910 INTEGER R1 /1/ 00000920 INTEGER R2 /2/ 00000930 INTEGER R3 /3/ 00000940 INTEGER R4 /4/ 00000950 INTEGER R5 /5/ 00000960 INTEGER R6 /6/ 00000970 INTEGER R7 /7/ 00000980 INTEGER R8 /8/ 00000990 INTEGER R9 /9/ 00001000 INTEGER R10 /10/ 00001010 INTEGER R14 /14/ 00001020 C 00001030 C CREATE 3838 BULK STORAGE ADDRESSES 00001040 C 00001050 APDISI = 1 00001060 APDISO = APDISI + 1 00001070 APSTAT = APDISO + 1 00001080 APNSI = APSTAT + 1 00001090 APMTFL = APNSI + 1 00001100 APMUTE = APMTFL + 1 00001110 APRLEN = APMUTE + 1 00001120 APONE = APRLEN + 2 00001130 APSLEN = APONE + 1 00001140 APSAMP = APSLEN + 5 00001150 APINTI = APSAMP + 1 00001160 APTZRO = APINTI + 7 00001170 APTRAZ = APTZRO + NOSAMP 00001180 APVELI = APTRAZ + NOSAMP + 4 00001190 APTZR2 = APVELI + NOSAMP 00001200 APINTP = APTZR2 + NOSAMP 00001210 APWORK = APINTP + 3 00001220 APWRK2 = APWORK + NOSAMP 00001230 APLIMT = APWRK2 + NOSAMP 00001240 C 00001250 CZ 00001260 CZ FLOWCHART FOR APPLYING NORMAL MOVEOUT IN 3838 00001270 CZ ============================================= 00001280 CZ 00001290 CZ 1 COMPUTE T0**2 WHERE T0 IS TIME ZERO. 00001300 CZ 00001310 CZ 2 COMPUTE X/V WHERE X IS THE SHOTPOINT TO TRACE 00001320 CZ DISTANCE AND V IS THE VELOCITY FUNCTION. 00001330 CZ 00001340 CZ 3 COMPUTE (X/V)**2. 00001350 CZ 00001360 CZ 4 COMPUTE T0**2 + (X/V)**2. 00001370 CZ 00001380 CZ 5 COMPUTE TR = (T0**2 + (X/V)**2)**0.5. 00001390 CZ 00001400 CZ 5A APPLY STATIC SHIFT 00001410 CZ 00001420 CZ 6 APPLY NMO VIA QUADRATIC INTERPOLATION. 00001430 CZ 00001440 CZ 7 APPLY MUTE IF ASKED TO DO SO 00001450 CZ 00001460 CZ ======================================================== 00001470 CZ 00001480 CZ FLOWCHART FOR ADJUSTING THE VELOCITIES FOR APPLYING 00001490 CZ DIFFERENTIAL NORMAL MOVEOUT 00001500 CZ 00001510 CZ A COMPUTE MOVEOUT FOR THE INPUT DISTANCE 00001520 CZ TXIN = (T0**2 + (XIN / V)**2)**0.5 00001530 CZ 00001540 CZ B COMPUTE MOVEOUT FOR THE OUTPUT DISTANCE 00001550 CZ TXOUT = (T0**2 + (XOUT / V)**2)**0.5 00001560 CZ 00001570 CZ C COMPUTE THE DIFFERENTIAL MOVEOUT 00001580 CZ DTX = ABS(TXIN - TXOUT) 00001590 CZ 00001600 CZ D BRING BACK TO THE HOST TO SAMPLE THE DELTA T ARRAY 00001610 CZ AT EVEN TIME INCREMENTS 00001620 CZ 00001630 CZ E ADJUST THE VELOCITIES 00001640 CZ V = XIN / ((DTX * (DTX + (2.0 * TXOUT))) ** 0.5) 00001650 CZ 00001660 CZ ======================================================== 00001670 CZ REGISTERS 00001680 CZ 00001690 CZ REG 1 NOSAMP 00001700 CZ 00001710 CZ REG 2 NUMBER OF LIVE VALUES (FOR MUTE) AND WORK 00001720 CZ 00001730 CZ REG 3 INDEX OF FIRST LIVE VALUE (FOR MUTE) AND WORK 00001740 CZ 00001750 CZ REG 4 NUMBER OF SAMPLES TO INTERPOLATE AT ONE TIME 00001760 CZ 00001770 CZ REG 5 INDEX OF TIME TRACE FOR START OF INTERPOLATION 00001780 CZ 00001790 CZ REG 6 TOTAL NUMBER OF SAMPLES INTERPOLATED 00001800 CZ 00001810 CZ REG 7 LENGTH OF SECTION OF INPUT TRACE PROCESSED 00001820 CZ 00001830 CZ REG 8 INDEX INTO INPUT TRACE 00001840 CZ 00001850 CZ REG 9 NUMBER OF SAMPLES LEFT TO PROCESS 00001860 CZ 00001870 CZ REG 10 SECTION NUMBER 00001880 CZ 00001890 CZ REG 13 DIFFERENTIAL MOVEOUT FLAG 00001900 CZ 00001910 CZ REG 14 MUTE FLAG AND WORK 00001920 CZ 00001930 CZ ======================================================== 00001940 C 00001950 C 3838 COMMANDS TO PERFORM ABOVE 00001960 C 00001970 CALL VPSS (APUNIT, 'BLD ', 7, CCW1, LCCW1, CIT1, LCIT1) 00001980 C 00001990 C MOVE DATA TO ARRAY PROCESSOR 00002000 C 00002010 CALL VPSS (APUNIT, 'VPUT', APINDX, APLEN, 1, 0) 00002020 IF (DNMO .EQ. 0) 00002030 *CALL VPSS (APUNIT, 'VPUT', TRACE, NOSAMP, APTRAZ, 0) 00002040 CALL VPSS (APUNIT, 'VPUT', VELTAB, NOSAMP, APVELI, 0) 00002050 C 00002060 CALL VPSS (APUNIT, 'XMVS', APNSI, 1, 0, R1) 00002070 C 00002080 C STEP 1 COMPUTE T0 ** 2 00002090 C 00002100 CALL VPSS (APUNIT, 'SSA ', 0, 00002110 * 64, APTZR2, 0, 1, R1, 00002120 * 0, APTZRO) 00002130 C 00002140 C CHECK FOR DIFFERENTIAL NORMAL MOVEOUT 00002150 C 00002160 IF (DNMO .EQ. 0) GO TO 10 00002170 C 00002180 C***********************************************************************00002190 C *00002200 C ADJUST THE VELOCITIES IN ORDER TO PERFORM DIFFERENTIAL *00002210 C MOVEOUT FROM DISTANCE XIN TO XOUT, XOUT < XIN AND XOUT NOT ZERO *00002220 C NOTE: XIN => APDISI XOUT => APDISO *00002230 C *00002240 C***********************************************************************00002250 C 00002260 C COMPUTE XIN / V 00002270 C 00002280 CALL VPSS (APUNIT, 'SDIV', 8, 00002290 * 64, APWORK, 0, 1, R1, 00002300 * 0, APVELI, 1, 00002310 * 0, APDISI) 00002320 C 00002330 C COMPUTE XOUT / V 00002340 C 00002350 CALL VPSS (APUNIT, 'SDIV', 8, 00002360 * 64, APWRK2, 0, 1, R1, 00002370 * 0, APVELI, 1, 00002380 * 0, APDISO) 00002390 C 00002400 C COMPUTE (XIN / V) ** 2 00002410 C 00002420 CALL VPSS (APUNIT, 'SSA ', 0, 00002430 * 64, APWORK, 0, 1, R1, 00002440 * 0, APWORK) 00002450 C 00002460 C COMPUTE (XOUT / V) ** 2 00002470 C 00002480 CALL VPSS (APUNIT, 'SSA ', 0, 00002490 * 64, APWRK2, 0, 1, R1, 00002500 * 0, APWRK2) 00002510 C 00002520 C COMPUTE T0 ** 2 + (XIN / V) ** 2 00002530 C 00002540 CALL VPSS (APUNIT, 'VES ', 0, 00002550 * 64, APVELI, 0, 1, R1, 00002560 * 0, APWORK, 1, 00002570 * 0, APTZR2) 00002580 C 00002590 C COMPUTE TXIN = (T0 ** 2 + (XIN / V) ** 2) ** 0.5 00002600 C 00002610 CALL VPSS (APUNIT, 'SQRT', 0, 00002620 * 64, APWORK, 0, 1, R1, 00002630 * 0, APVELI) 00002640 C 00002650 C COMPUTE T0 ** 2 + (XOUT / V) ** 2 00002660 C 00002670 CALL VPSS (APUNIT, 'VES ', 0, 00002680 * 64, APVELI, 0, 1, R1, 00002690 * 0, APWRK2, 1, 00002700 * 0, APTZR2) 00002710 C 00002720 C COMPUTE TXOUT = (T0 ** 2 + (XOUT / V) ** 2) ** 0.5 00002730 C 00002740 CALL VPSS (APUNIT, 'SQRT', 0, 00002750 * 64, APWRK2, 0, 1, R1, 00002760 * 0, APVELI) 00002770 C 00002780 C COMPUTE DTX = (TXIN - TXOUT) 00002790 C 00002800 CALL VPSS (APUNIT, 'VES ', 0, 00002810 * 64, APWORK, 0, 1, R1, 00002820 * 0, APWORK, 1, 00002830 * 8, APWRK2) 00002840 C 00002850 C COMPUTE TEMP1(I) = DTX(I) - DTX(I-1) 00002860 C 00002870 CALL VPSS (APUNIT, 'VES ', 0, 00002880 * 64, APTRAZ+1, -1, 1, R1, 00002890 * 0, APWORK+1, 1, 00002900 * 8, APWORK) 00002910 C 00002920 C COMPUTE TEMP2(I) = TXOUT(I) - TXOUT(I-1) 00002930 C 00002940 CALL VPSS (APUNIT, 'VES ', 0, 00002950 * 64, APVELI+1, -1, 1, R1, 00002960 * 0, APWRK2+1, 1, 00002970 * 8, APWRK2) 00002980 C 00002990 C COMPUTE FACT = TEMP1 / TEMP2 00003000 C 00003010 CALL VPSS (APUNIT, 'DIV ', 0, 00003020 * 64, APTRAZ+1, -1, 1, R1, 00003030 * 0, APVELI+1, 1, 00003040 * 0, APTRAZ+1) 00003050 C 00003060 C TRANSFER DELTAS BACK TO THE 370 FOR INTERPOLATION 00003070 C 00003080 CALL VPSS (APUNIT, 'VGET', TRACE, NOSAMP, APWORK, 0) 00003090 CALL VPSS (APUNIT, 'VGET', TRACE, NOSAMP, APWRK2, 0) 00003100 CALL VPSS (APUNIT, 'VGET', TRACE, NOSAMP, APTRAZ, 0) 00003110 C 00003120 C TRANSLATE THE COMMANDS 00003130 C 00003140 CALL VPSS (APUNIT, 'XLTE', APDNMO) 00003150 C 00003160 C NOW MOVE THE DATA BACK INTO THE 3838 TO COMPLETE THE DNMO 00003170 C 00003180 CALL VPSS (APUNIT, 'BLD ', 7, CCW2, LCCW2, CIT2, LCIT2) 00003190 CALL VPSS (APUNIT, 'VPUT', APINDX, APLEN, 1, 0) 00003200 CALL VPSS (APUNIT, 'VPUT', TRACE, NOSAMP, APTRAZ, 0) 00003210 CALL VPSS (APUNIT, 'VPUT', TRACE, NOSAMP, APWORK, 0) 00003220 C 00003230 CALL VPSS (APUNIT, 'XMVS', APNSI, 1, 0, R1) 00003240 C 00003250 C RE-COMPUTE T0 ** 2 00003260 C 00003270 CALL VPSS (APUNIT, 'SSA ', 0, 00003280 * 64, APTZR2, 0, 1, R1, 00003290 * 0, APTZRO) 00003300 C 00003310 C USE THE DIFFERENTIAL MOVEOUT TO ADJUST THE VELOCITIES 00003320 C 00003330 C COMPUTE 2.0 * T0 00003340 C 00003350 CALL VPSS (APUNIT, 'VES ', 0, 00003360 * 64, APWRK2, 0, 1, R1, 00003370 * 0, APTZRO, 1, 00003380 * 0, APTZRO) 00003390 C 00003400 C COMPUTE DTX + (2.0 * T0) 00003410 C 00003420 CALL VPSS (APUNIT, 'VES ', 0, 00003430 * 64, APWRK2, 0, 1, R1, 00003440 * 0, APWRK2, 1, 00003450 * 4, APWORK) 00003460 C 00003470 C COMPUTE DTX * (DTX + (2.0 * T0)) 00003480 C 00003490 CALL VPSS (APUNIT, 'VEM ', 0, 00003500 * 64, APWRK2, 0, 1, R1, 00003510 * 0, APWRK2, 1, 00003520 * 4, APWORK) 00003530 C 00003540 C COMPUTE (DTX * (DTX + (2.0 * T0))) ** 0.5 00003550 C 00003560 CALL VPSS (APUNIT, 'SQRT', 0, 00003570 * 64, APWORK, 0, 1, R1, 00003580 * 0, APWRK2) 00003590 C 00003600 C COMPUTE THE ADJUSTED VELOCITIES 00003610 C 00003620 CALL VPSS (APUNIT, 'SDIV', 8, 00003630 * 64, APVELI, 0, 1, R1, 00003640 * 0, APWORK, 1, 00003650 * 0, APDISI) 00003660 C 00003670 C***********************************************************************00003680 C *00003690 C VELOCITY ADJUSTMENT COMPLETE - CONTINUE WITH THE NORMAL *00003700 C MOVEOUT APPLICATION *00003710 C *00003720 C***********************************************************************00003730 C 00003740 C STEP 2 COMPUTE X/V 00003750 C 00003760 10 CALL VPSS (APUNIT, 'SDIV', 8, 00003770 * 64, APVELI, 0, 1, R1, 00003780 * 0, APVELI, 1, 00003790 * 0, APDISI) 00003800 C 00003810 C STEP 3 COMPUTE (X/V)**2 00003820 C 00003830 CALL VPSS (APUNIT, 'SSA ', 0, 00003840 * 64, APVELI, 0, 1, R1, 00003850 * 0, APVELI) 00003860 C 00003870 C STEP 4 COMPUTE T0**2 + (X/V)**2 00003880 C 00003890 CALL VPSS (APUNIT, 'VES ', 0, 00003900 * 64, APVELI, 0, 1, R1, 00003910 * 0, APVELI, 1, 00003920 * 0, APTZR2) 00003930 C 00003940 C STEP 5 COMPUTE TR = (T0**2 + (X/V)**2)**0.5 00003950 C 00003960 CALL VPSS (APUNIT, 'SQRT', 8, 00003970 * 64, APWORK, 0, 1, R1, 00003980 * 0, APVELI) 00003990 C 00004000 C STEP 5A APPLY STATIC 00004010 C 00004020 CALL VPSS (APUNIT, 'SSUM', 0, 00004030 * 64, APWORK, 0, 1, R1, 00004040 * 0, APWORK, 1, 00004050 * 8, APSTAT) 00004060 C 00004070 C ZERO OUT OUTPUT ARRAY AND WORK ARRAY 00004080 C 00004090 CALL VPSS (APUNIT, 'ZMV ', 0, 00004100 * 64, APVELI, 0, 1, R1) 00004110 C 00004120 CALL VPSS (APUNIT, 'ZMV ', 0, 00004130 * 0, APLIMT, 4) 00004140 C 00004150 C ZERO OUT INT PARAMETERS TO AVOID UNDERFLOW 00004160 C 00004170 CALL VPSS (APUNIT, 'ZMV ', 0, 00004180 * 0, APINTP, 4) 00004190 C 00004200 C ZERO OUT FOUR WORDS PAST END OF INPUT TRACE 00004210 C 00004220 CALL VPSS (APUNIT, 'ZMV ', 0, 00004230 * 32, APTRAZ, 4, 1, R1) 00004240 C 00004250 C MOVE UPPER LIMITS INTO APLIMT 00004260 C 00004270 CALL VPSS (APUNIT, 'VMV ', 0, 00004280 * 0, APLIMT, 2, 1, 00004290 * 0, APRLEN) 00004300 C 00004310 C MAKE SURE DON'T INTERPOLATE TOO FAR 00004320 C 00004330 CALL VPSS (APUNIT, 'LIM ', 0, 00004340 * 64, APWORK, 0, 1, R1, 00004350 * 0, APWORK, 1, 00004360 * 0, APLIMT) 00004370 C 00004380 C STEP 6 APPLY NMO 00004390 C 00004400 C SET UP INDEXES IF MORE THAN 3995 SAMPLES 00004410 C 00004420 CALL VPSS (APUNIT, 'XMVI', R2, 1) 00004430 C 00004440 CALL VPSS (APUNIT, 'XMVI', R3, 2) 00004450 C 00004460 CALL VPSS (APUNIT, 'XMVI', R5, 0) 00004470 C 00004480 CALL VPSS (APUNIT, 'XMVI', R6, 0) 00004490 C 00004500 CALL VPSS (APUNIT, 'XMVI', R7, 3995) 00004510 C 00004520 CALL VPSS (APUNIT, 'XMVI', R8, 0) 00004530 C 00004540 CALL VPSS (APUNIT, 'XMVI', R10, 0) 00004550 C 00004560 CALL VPSS (APUNIT, 'XMVI', R14, 3) 00004570 C 00004580 C TEST IF MORE THAN 3995 SAMPLES 00004590 C 00004600 CALL VPSS (APUNIT, 'XCI ', R1, 3995, 'GT39', 'GT ') 00004610 C 00004620 C IF NOT SET UP APPROPRIATE REGISTERS 00004630 C 00004640 CALL VPSS (APUNIT, 'XMV ', R4, R1) 00004650 C 00004660 CALL VPSS (APUNIT, 'XMV ', R6, R1) 00004670 C 00004680 CALL VPSS (APUNIT, 'XMV ', R7, R1) 00004690 C 00004700 CALL VPSS (APUNIT, 'SMV ', 0, 00004710 * 64, APWRK2, 0, 1, R1, 00004720 * 0, APONE) 00004730 C 00004740 CALL VPSS (APUNIT, 'XGO ', 'INTP') 00004750 C 00004760 C COME HERE IF MORE THAN 3995 SAMPLES 00004770 C 00004780 CALL VPSS (APUNIT, 'XID ', 'GT39') 00004790 C 00004800 C REGISTER 9 IS THE NUMBER OF SAMPLES LEFT TO PROCESS 00004810 C 00004820 CALL VPSS (APUNIT, 'XMV ', R9, R1) 00004830 C 00004840 CALL VPSS (APUNIT, 'XSB ', R9, R6) 00004850 C 00004860 C MOVE TOTAL NUMBER DONE SO FAR TO REG 5 TO 00004870 C USE AS AN INDEX INTO THE COMPUTED TIMES ARRAY 00004880 C 00004890 CALL VPSS (APUNIT, 'XMV ', R5, R6) 00004900 C 00004910 C ZERO WORK AREAS 00004920 C 00004930 CALL VPSS (APUNIT, 'ZMV ', 0, 00004940 * 64, APWRK2, 4, 1, R1) 00004950 C 00004960 C MAKE UPPER AND LOWER LIMIT EQUAL TO END TIME OF SECTION 00004970 C 00004980 CALL VPSS (APUNIT, 'SMV ', 0, 00004990 * 0, APLIMT, 3, 1, 00005000 * 32, APSLEN, R10) 00005010 C 00005020 C MAKE SECOND 'LIM' PARAMETER EQUAL TO ONE 00005030 C 00005040 CALL VPSS (APUNIT, 'SMV ', 0, 00005050 * 32, APLIMT, 1, 1, R2, 00005060 * 0, APONE) 00005070 C 00005080 C FIND TIMES PAST END OF SECTION 00005090 C 00005100 CALL VPSS (APUNIT, 'LIM ', 0, 00005110 * 96, APWRK2, 0, 1, R5, R9, 00005120 * 32, APWORK, 1, R5, 00005130 * 0, APLIMT) 00005140 C 00005150 C FIND FIRST TIME PAST END OF SECTION 00005160 C 00005170 CALL VPSS (APUNIT, 'MAX ', 0, 00005180 * 0, APLIMT, 00005190 * 96, APWRK2, 0, 1, R5, R9) 00005200 C 00005210 C MOVE NUMBER TO DO INTO REG 4 00005220 C 00005230 CALL VPSS (APUNIT, 'XMVS', APLIMT, 1, R2, R4) 00005240 C 00005250 C TEST IF NUMBER TO DO IS GREATER THAN NUMBER LEFT 00005260 C 00005270 CALL VPSS (APUNIT, 'XC ', R4, R9, 'GTNL', 'GT ') 00005280 C 00005290 C TEST IF NUMBER TO DO IS GREATER THAN ZERO 00005300 C 00005310 CALL VPSS (APUNIT, 'XCI ', R4, 0, 'FOUN', 'GT ') 00005320 C 00005330 C REG 4 < = ZERO OR REG 4 > NUMBER LEFT TO PROCESS 00005340 C 00005350 CALL VPSS (APUNIT, 'XID ', 'GTNL') 00005360 C 00005370 C MOVE NUMBER LEFT TO PROCESS TO REG 4 00005380 C 00005390 CALL VPSS (APUNIT, 'XMV ', R4, R9) 00005400 C 00005410 C CONTINUE WITH PROCESSING 00005420 C 00005430 CALL VPSS (APUNIT, 'XID ', 'FOUN') 00005440 C 00005450 C COMPUTE NEW TOTAL DONE 00005460 C 00005470 CALL VPSS (APUNIT, 'XAD ', R6, R4) 00005480 C 00005490 C MOVE LOWER INPUT TIME LIMIT (IN SAMPLES) TO APLIMT 00005500 C 00005510 CALL VPSS (APUNIT, 'XMVX', APLIMT, 1, 0, R8) 00005520 C 00005530 C CONVERT TO FLOATING POINT 00005540 C 00005550 CALL VPSS (APUNIT, 'VMC ', 0, 00005560 * 0, APWRK2, 2, 1, 00005570 * 2, APLIMT) 00005580 C 00005590 C CORRECT DISPLACEMENT TO TIME ZERO (NEGATIVE) 00005600 C 00005610 CALL VPSS (APUNIT, 'VMV ', 0, 00005620 * 0, APINTI, 1, 1, 00005630 * 48, APWRK2, 1, R2) 00005640 C 00005650 C CONVERT TO SECONDS 00005660 C 00005670 CALL VPSS (APUNIT, 'VEM ', 0, 00005680 * 0, APWRK2, 1, 1, 00005690 * 32, APWRK2, 1, R2, 00005700 * 0, APSAMP) 00005710 C 00005720 C MOVE TO FIRST THREE 'LIM' PARAMETERS 00005730 C 00005740 CALL VPSS (APUNIT, 'SMV ', 0, 00005750 * 0, APLIMT, 3, 1, 00005760 * 0, APWRK2) 00005770 C 00005780 C MOVE ONE TO SECOND 'LIM' PARAMETER 00005790 C 00005800 CALL VPSS (APUNIT, 'SMV ', 0, 00005810 * 32, APLIMT, 1, 1, R2, 00005820 * 0, APONE) 00005830 C 00005840 C MOVE ZERO TO FOURTH 'LIM' PARAMETER 00005850 C 00005860 CALL VPSS (APUNIT, 'ZMV ', 0, 00005870 * 32, APLIMT, 1, 1, R14) 00005880 C 00005890 C CHECK IF ANY TIMES BELOW LOWER TIME LIMIT 00005900 C 00005910 CALL VPSS (APUNIT, 'LIM ', 0, 00005920 * 96, APWRK2, 0, 1, R5, R4, 00005930 * 32, APWORK, 1, R5, 00005940 * 0, APLIMT) 00005950 C 00005960 C COME HERE TO DO ACTUAL INTERPOLATION 00005970 C 00005980 CALL VPSS (APUNIT, 'XID ', 'INTP') 00005990 C 00006000 C MOVE TIMES SO DON'T GET DESTROYED 00006010 C 00006020 CALL VPSS (APUNIT, 'VMV ', 0, 00006030 * 0, APLIMT, 3, 1, 00006040 * 32, APINTP, 1, R5) 00006050 C 00006060 C MOVE INT PARAMETERS INTO CORRECT AREA 00006070 C 00006080 CALL VPSS (APUNIT, 'VMV ', 0, 00006090 * 32, APINTP, 3, 1, R5, 00006100 * 0, APINTI) 00006110 C 00006120 C DO QUADRATIC INTERPOLATION 00006130 C 00006140 CALL VPSS (APUNIT, 'INT ', 0, 00006150 * 96, APVELI, 0, 1, R5, R4, 00006160 * 96, APTRAZ, 4, 1, R8, R7, 00006170 * 96, APINTP, 3, 1, R5, R4) 00006180 C 00006190 C REPLACE TIMES 00006200 C 00006210 CALL VPSS (APUNIT, 'VMV ', 0, 00006220 * 32, APINTP, 3, 1, R5, 00006230 * 0, APLIMT) 00006240 C 00006250 C COMPENSATE FOR VALUES POINTING ABOVE THE SECTION 00006260 C 00006270 CALL VPSS (APUNIT, 'VEM ', 0, 00006280 * 96, APVELI, 0, 1, R5, R4, 00006290 * 32, APVELI, 1, R5, 00006300 * 32, APWRK2, 1, R5) 00006310 C 00006320 C INCREMENT TRACE INDEX 00006330 C 00006340 CALL VPSS (APUNIT, 'XAD ', R8, R7) 00006350 C 00006360 C ALLOW FOR TWO SAMPLE OVERLAP 00006370 C 00006380 CALL VPSS (APUNIT, 'XSBI', R8, 2) 00006390 C 00006400 C INCREMENT SECTION NUMBER 00006410 C 00006420 CALL VPSS (APUNIT, 'XADI', R10, 1) 00006430 C 00006440 C CHECK IF THROUGH WITH TRACE 00006450 C 00006460 CALL VPSS (APUNIT, 'XC ', R6, R1, 'GT39', 'LT ') 00006470 C 00006480 C STEP 7 CHECK FOR MUTE APPLICATION 00006490 C 00006500 CALL VPSS (APUNIT, 'XMVS', 00006510 * APMTFL, 1, 0, R14) 00006520 C 00006530 C APPLY MUTE IF ASKED FOR, OTHERWISE GO TO 'CONT' 00006540 C 00006550 CALL VPSS (APUNIT, 'XCI ', R14, 0, 'CONT', 'EQ ') 00006560 C 00006570 C SET UP 1/(1+LIMDT)*TR FOR COMPARISON 00006580 C 00006590 C IF T0 <= 1/(1+LIMDT)*TR THEN ZERO 00006600 C 00006610 CALL VPSS (APUNIT, 'SMY ', 0, 00006620 * 64, APWORK, 0, 1, R1, 00006630 * 0, APWORK, 1, 00006640 * 0, APMUTE) 00006650 C 00006660 C SUBTRACT ABOVE FROM T ZERO 00006670 C 00006680 CALL VPSS (APUNIT, 'VES ', 0, 00006690 * 64, APWORK, 0, 1, R1, 00006700 * 0, APTZRO, 1, 00006710 * 8, APWORK) 00006720 C 00006730 C MOVE ZEROS INTO FOUR WORDS USED IN LIM 00006740 C 00006750 CALL VPSS (APUNIT, 'ZMV ', 0, 00006760 * 0, APLIMT, 4, 1) 00006770 C 00006780 C MOVE FLOATING POINT ONE TO SECOND WORD OF APLIMT 00006790 C 00006800 CALL VPSS (APUNIT, 'SMV ', 0, 00006810 * 32, APLIMT, 1, 1, R2, 00006820 * 0, APONE) 00006830 C 00006840 C SUBSTITUTE ZEROS WHERE MUTE, ONES WHERE NO MUTE 00006850 C 00006860 CALL VPSS (APUNIT, 'LIM ', 0, 00006870 * 64, APWORK, 0, 1, R1, 00006880 * 0, APWORK, 1, 00006890 * 0, APLIMT) 00006900 C 00006910 C FIND FIRST ONE 00006920 C 00006930 CALL VPSS (APUNIT, 'MAX ', 0, 00006940 * 0, APLIMT, 00006950 * 64, APWORK, 0, 1, R1) 00006960 C 00006970 C SET UP INDEXES 00006980 C 00006990 CALL VPSS (APUNIT, 'XMVS', 00007000 * APLIMT, 1, R2, R3) 00007010 C 00007020 CALL VPSS (APUNIT, 'XMV ', R2, R1) 00007030 C 00007040 CALL VPSS (APUNIT, 'XSB ', R2, R3) 00007050 C 00007060 C MOVE ONES INTO ARRAY 00007070 C 00007080 CALL VPSS (APUNIT, 'SMV ', 0, 00007090 * 96, APWORK, 0, 1, R3, R2, 00007100 * 0, APONE) 00007110 C 00007120 C APPLY MUTE 00007130 C 00007140 CALL VPSS (APUNIT, 'VEM ', 0, 00007150 * 64, APVELI, 0, 1, R1, 00007160 * 0, APVELI, 1, 00007170 * 0, APWORK) 00007180 C 00007190 C CONTROL IS PASSED TO HERE IF NO MUTE IS APPLIED 00007200 C 00007210 CALL VPSS (APUNIT, 'XID ', 'CONT') 00007220 C 00007230 C TRANSFER DATA BACK TO 370 00007240 C 00007250 CALL VPSS (APUNIT, 'VGET', TRACE, NOSAMP, APVELI, 0) 00007260 C 00007270 C TRANSLATE THE COMMANDS 00007280 C 00007290 CALL VPSS (APUNIT, 'XLTE', APNMOC) 00007300 C 00007310 RETURN 00007320 END 00007330