CTITLESACVN2 -- CVAN ARRAY PROCESSOR CALLS 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 05-25-78 00000050 C REVISED 06-07-78 COOPER - FORCED 'INT' DISPLACEMENT00000060 C TO BE NEGATIVE. 00000070 C REVISED 10-09-78 COOPER -PUT IN ABILITY TO DO MORE 00000080 C THAN ONE VELOCITY IN A CALL. ALSO 00000090 C ADDED APOUT TO ARGUMENT LIST. 00000100 C REVISED 04-21-80 COOPER - CHANGED BLD ISTATE TO 3, TO PAGE FIX 00000110 C AT EXECUTION TIME. 00000120 C 00000130 CA 00000140 CA 00000150 CA CALL SACVN2 (APUNIT,APLEN,APCVAN,NOSAMP,CCW,CIT,APINDX,APOUT) 00000160 CA INPUT APUNIT = ARRAY PROCESSOR UNIT I4 00000170 CA INPUT APLEN = NUMBER OF WORDS TO PASS TO THE AP3838 I4 00000180 CA OUTPUT APCVAN = ADDRESS OF TRANSLATE TABLE I4 00000190 CA INPUT NOSAMP = NUMBER OF SAMPLES IN TRACE I4 00000200 CA IN/OUT CCW = ADDRESS OF CCW TABLE R8 00000210 CA IN/OUT CIT = ADDRESS OF CIT TABLE I4 00000220 CA INPUT APINDX = ADDRESS OF WORDS TO PASS TO AP3838 I4 00000230 CA OUTPUT APOUT = OUTPUT ADDRESS I4 00000240 CA 00000250 CA 00000260 CA THIS SUBROUTINE CONTAINS THE 3838 ARRAY PROCESSOR CALLS USED 00000270 CA BY SDCVAN TO PERFORM THE CONSTANT VELOCITY MOVEOUT. 00000280 CA 00000290 C EJECT IF ABSTRACTS NEEDS A PAGE EJECT PUT 'A' IN COLUMN 2. 00000300 C 00000310 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 00000320 C 00000330 C APDISI = ADDRESS IN BULK STORAGE OF TRACE DISTANCE I4 00000340 C APINTI = ADDRESS OF 'INT' PARAMETERS I4 00000350 C APINTP = ADDRESS OF 'INT' WORK PARAMETERS I4 00000360 C APLIMT = ADDRESS OF 4 WORD WORD ARRAY, USED IN 'LIM' I4 00000370 C APMTFL = ADDRESS OF MUTE FLAG I4 00000380 C APMUTE = ADDRESS OF MUTING LIMIT I4 00000390 C APNDON = ADDRESS OF NUMBER OF SAMPLES TO DO I4 00000400 C APNSI = ADDRESS OF NUMBER OF SAMPLES I4 00000410 C APONE = ADDRESS OF FLOATING POINT ONE I4 00000420 C APOUT = ADDRESS TO WHICH OUTPUT IS TO BE PUT I4 00000430 C APRAMP = ADDRESS OF A LINEAR RAMP USED TO CREATE INPUT I4 00000440 C APRLEN = ADDRESS OF RECORD LENGTH IN SECONDS I4 00000450 C APSAMP = ADDRESS OF SAMPLE RATE IN SECONDS I4 00000460 C APSLEN = ADDRESS OF FIVE SECTION LENGTH LIMITS CAUSED BY 'INT'I4 00000470 C APSTOR = ADDRESS WHERE OUTPUT IS TEMPORARILY STORED I4 00000480 C APSVEL = ADDRESS OF STARTING VELOCITY I4 00000490 C APTRAZ = ADDRESS OF INPUT TRACE (AND OUTPUT) I4 00000500 C APTVIN = ADDRESS OF VELOCITY INCREMENT PER TIME I4 00000510 C APTZRO = ADDRESS OF TIME ZERO ARRAY (SAMPLE TIME IN SECONDS) I4 00000520 C APVELI = ADDRESS OF VELOCITY FUNCTION I4 00000530 C APVINC = ADDRESS OF VELOCITY INCREMENT I4 00000540 C APWORK = ADDRESS OF WORK ARRAY I4 00000550 C APWRK2 = ADDRESS OF WORK ARRAY I4 00000560 C APZERO = ADDRESS OF FOUR ZEROS PAST END OF INPUT TRACE I4 00000570 C R1 = NUMBER OF SAMPLES I4 00000580 C R2 = NUMBER OF LIVE VALUES (FOR MUTE) AND WORK I4 00000590 C R3 = INDEX OF FIRST LIVE VALUE (FOR MUTE) AND WORK I4 00000600 C R4 = NUMBER OF SAMPLES TO INTERPOLATE AT ONE TIME I4 00000610 C R5 = INDEX INTO COMPUTED TIMES FOR START OF INTERPOLATION I4 00000620 C R6 = TOTAL NUMBER OF SAMPLES INTERPOLATED I4 00000630 C R7 = LENGTH OF SECTION OF INPUT TRACE PROCESSED I4 00000640 C R8 = INDEX INTO INPUT TRACE I4 00000650 C R9 = NUMBER OF SAMPLES LEFT TO PROCESS I4 00000660 C R10 = SECTION NUMBER (STARTING WITH ZERO) I4 00000670 C R11 = INDEX INTO OUTPUT AREA I4 00000680 C R12 = TOTAL NUMBER OF SAMPLES TO DO I4 00000690 C R14 = MUTE FLAG AND WORK I4 00000700 C 00000710 SUBROUTINE SACVN2 (APUNIT,APLEN,APCVAN,NOSAMP,CCW,CIT,APINDX, 00000720 * APOUT) 00000730 C 00000740 IMPLICIT INTEGER (A-Z) 00000750 C 00000760 C ARRAYS -- IN PARAMETER LIST 00000770 C 00000780 REAL * 8 CCW (100) 00000790 INTEGER CIT (1) 00000800 INTEGER APINDX (1) 00000810 INTEGER APOUT (1) 00000820 C 00000830 C INTEGER VARIABLES AND CONSTANTS -- LOCAL 00000840 C 00000850 INTEGER R1 /1/ 00000860 INTEGER R2 /2/ 00000870 INTEGER R3 /3/ 00000880 INTEGER R4 /4/ 00000890 INTEGER R5 /5/ 00000900 INTEGER R6 /6/ 00000910 INTEGER R7 /7/ 00000920 INTEGER R8 /8/ 00000930 INTEGER R9 /9/ 00000940 INTEGER R10 /10/ 00000950 INTEGER R11 /11/ 00000960 INTEGER R12 /12/ 00000970 INTEGER R14 /14/ 00000980 C 00000990 C 00001000 C SET UP 3838 BULK STORAGE ADDRESSES 00001010 C 00001020 APDISI = 1 00001030 APNSI = APDISI + 1 00001040 APMTFL = APNSI + 1 00001050 APMUTE = APMTFL + 1 00001060 APONE = APMUTE + 1 00001070 APSVEL = APONE + 1 00001080 APTVIN = APSVEL + 1 00001090 APSAMP = APTVIN + 1 00001100 APINTI = APSAMP + 1 00001110 APRLEN = APINTI + 3 00001120 APSLEN = APRLEN + 2 00001130 APVINC = APSLEN + 3 00001140 APNDON = APVINC + 1 00001150 NSDONE = APINDX(APNDON) 00001160 APTRAZ = APNDON + 3 00001170 APZERO = APTRAZ + NOSAMP 00001180 APTZRO = APZERO + 4 00001190 APVELI = APTZRO + NOSAMP 00001200 APINTP = APVELI + NOSAMP 00001210 APWORK = APINTP + 3 00001220 APWRK2 = APWORK + NOSAMP 00001230 APLIMT = APWRK2 + NOSAMP 00001240 APRAMP = APLIMT + 4 00001250 APSTOR = APRAMP + NOSAMP 00001260 C 00001270 CZ 00001280 CZ FLOWCHART FOR APPLYING NORMAL MOVEOUT IN 3838 00001290 CZ ========================================================= 00001300 CZ 00001310 CZ 1 MOVE DATA TO ARRAY PROCESSOR. 00001320 CZ 00001330 CZ 2 INITIALIZE REGISTERS AND BULK STORAGE. 00001340 CZ 00001350 CZ 3 COMPUTE X/V WHERE X IS THE SHOTPOINT OT TRACE 00001360 CZ DISTANCE AND V IS THE VELOCITY FUNCTION. 00001370 CZ 00001380 CZ 4 COMPUTE (X/V)**2. 00001390 CZ 00001400 CZ 5 COMPUTE T0**2 WHERE T0 IS TIME ZERO. 00001410 CZ 00001420 CZ 6 COMPUTE T0**2 + (X/V)**2. 00001430 CZ 00001440 CZ 7 COMPUTE TR = (T0*82 + (X/V)**2)**0.5. 00001450 CZ 00001460 CZ 8 APPLY NMO VIA QUADRATIC INTERPOLATION. 00001470 CZ 00001480 CZ 9 APPLY MUTE IF ASKED TO DO SO. 00001490 CZ 00001500 CZ 10 RETURN DATA TO 370. 00001510 CZ 00001520 CZ ========================================================= 00001530 C 00001540 C 3838 COMMANDS TO PERFORM ABOVE STEPS 00001550 C 00001560 CALL VPSS (APUNIT, 'BLD ', 3, CCW, 100, CIT, 1000) 00001570 C 00001580 C STEP 1 MOVE DATA TO ARRAY PROCESSOR 00001590 C 00001600 CALL VPSS (APUNIT, 'VPUT', APINDX, APLEN, 1, 0) 00001610 C 00001620 C STEP 2 INITIALIZE REGISTERS AND BULK STORAGE 00001630 C 00001640 CALL VPSS (APUNIT, 'XMVS', APNSI, 1, 0, R1) 00001650 C 00001660 CALL VPSS (APUNIT, 'XMVI', R11, 0) 00001670 C 00001680 CALL VPSS (APUNIT, 'XMVS', APNDON, 1, 0, R12) 00001690 C 00001700 CALL VPSS (APUNIT, 'VMV ', 0, 00001710 * 0, APNSI, 1, 1, 00001720 * 0, APVINC) 00001730 C 00001740 C MOVE RAMP INTO APRAMP TO SAVE FOR ALL CALCULATIONS 00001750 C 00001760 CALL VPSS (APUNIT, 'VMV ', 0, 00001770 * 64, APRAMP, 0, 1, R1, 00001780 * 0, APTZRO) 00001790 C 00001800 C MOVE SAMPLE RATE INTO TIME ZERO ARRAY 00001810 C 00001820 CALL VPSS (APUNIT, 'SMV ', 0, 00001830 * 64, APTZRO, 0, 1, R1, 00001840 * 0, APSAMP) 00001850 C 00001860 C MULTIPLY BY RAMP TO GET TIME IN SECONDS 00001870 C 00001880 CALL VPSS (APUNIT, 'VEM ', 0, 00001890 * 64, APTZRO, 0, 1, R1, 00001900 * 0, APTZRO, 1, 00001910 * 0, APRAMP) 00001920 C 00001930 C LOOP TO MOVEOUT DATA FOR MORE THAN ONE VELOCITY 00001940 C 00001950 CALL VPSS (APUNIT, 'XID ', 'LOOP') 00001960 C 00001970 C MOVE STARTING VELOCITY TO VELOCITY ARRAY 00001980 C 00001990 CALL VPSS (APUNIT, 'SMV ', 0, 00002000 * 64, APVELI, 0, 1, R1, 00002010 * 0, APSVEL) 00002020 C 00002030 C MULTIPLY RAMP BY VELOCITY INCREMENT PER TIME 00002040 C 00002050 CALL VPSS (APUNIT, 'SMY ', 0, 00002060 * 64, APWORK, 0, 1, R1, 00002070 * 0, APRAMP, 1, 00002080 * 0, APTVIN) 00002090 C 00002100 C TEST IF FIRST VELOCITY 00002110 C 00002120 CALL VPSS (APUNIT, 'XCI ', R11, 0, 'FRST', 'EQ ') 00002130 C 00002140 C SUM ADDITIONAL VELOCITY INCREMENT IF NOT FIRST VEL. 00002150 C 00002160 CALL VPSS (APUNIT, 'SSUM', 0, 00002170 * 64, APWORK, 0, 1, R1, 00002180 * 0, APWORK, 1, 00002190 * 0, APVINC) 00002200 C 00002210 C INCREMENT VELOCITY FOR NEXT CALCULATION 00002220 C 00002230 CALL VPSS (APUNIT, 'SSUM', 0, 00002240 * 0, APVINC, 1, 1, 00002250 * 0, APVINC, 1, 00002260 * 0, APNSI) 00002270 C 00002280 C COME HERE IF FIRST VELOCITY 00002290 C 00002300 CALL VPSS (APUNIT, 'XID ', 'FRST') 00002310 C 00002320 C SUM IN VELOCITY INCREMENTS 00002330 C 00002340 CALL VPSS (APUNIT, 'VES ', 0, 00002350 * 64, APVELI, 0, 1, R1, 00002360 * 0, APVELI, 1, 00002370 * 0, APWORK) 00002380 C 00002390 C ZERO OUT INT PARAMETERS AND WORK ARRAY 00002400 C 00002410 CALL VPSS (APUNIT, 'ZMV ', 0, 00002420 * 64, APINTP, 3, 1, R1) 00002430 C 00002440 C STEP 3 COMPUTE X/V 00002450 C 00002460 CALL VPSS (APUNIT, 'SDIV', 8, 00002470 * 64, APVELI, 0, 1, R1, 00002480 * 0, APVELI, 1, 00002490 * 0, APDISI) 00002500 C 00002510 C STEP 4 COMPUTE (X/V)**2 00002520 C 00002530 CALL VPSS (APUNIT, 'SSA ', 0, 00002540 * 64, APVELI, 0, 1, R1, 00002550 * 0, APVELI) 00002560 C 00002570 C STEP 5 COMPUTE T0**2 00002580 C 00002590 CALL VPSS (APUNIT, 'SSA ', 0, 00002600 * 64, APWORK, 0, 1, R1, 00002610 * 0, APTZRO) 00002620 C 00002630 C STEP 6 COMPUTE T0**2 + (X/V)**2 00002640 C 00002650 CALL VPSS (APUNIT, 'VES ', 0, 00002660 * 64, APVELI, 0, 1, R1, 00002670 * 0, APVELI, 1, 00002680 * 0, APWORK) 00002690 C 00002700 C STEP 7 COMPUTE TR = (T0**2 + (X/V)**2)**0.5 00002710 C 00002720 CALL VPSS (APUNIT, 'SQRT', 8, 00002730 * 64, APWORK, 0, 1, R1, 00002740 * 0, APVELI) 00002750 C 00002760 C ZERO OUT OUTPUT ARRAY AND WORK ARRAY 00002770 C 00002780 CALL VPSS (APUNIT, 'ZMV ', 0, 00002790 * 64, APVELI, 0, 1, R1) 00002800 C 00002810 CALL VPSS (APUNIT, 'ZMV ', 0, 00002820 * 0, APLIMT, 4) 00002830 C 00002840 C MOVE UPPER LIMITS INTO APLIMT 00002850 C 00002860 CALL VPSS (APUNIT, 'VMV ', 0, 00002870 * 0, APLIMT, 2, 1, 00002880 * 0, APRLEN) 00002890 C 00002900 C MAKE SURE DON'T INTERPOLATE TOO FAR 00002910 C 00002920 CALL VPSS (APUNIT, 'LIM ', 0, 00002930 * 64, APWORK, 0, 1, R1, 00002940 * 0, APWORK, 1, 00002950 * 0, APLIMT) 00002960 C 00002970 C STEP 8 APPLY NMO 00002980 C 00002990 C SET UP INDEXES IF MORE THAN 3995 SAMPLES 00003000 C 00003010 CALL VPSS (APUNIT, 'XMVI', R2, 1) 00003020 C 00003030 CALL VPSS (APUNIT, 'XMVI', R3, 2) 00003040 C 00003050 CALL VPSS (APUNIT, 'XMVI', R5, 0) 00003060 C 00003070 CALL VPSS (APUNIT, 'XMVI', R6, 0) 00003080 C 00003090 CALL VPSS (APUNIT, 'XMVI', R7, 3995) 00003100 C 00003110 CALL VPSS (APUNIT, 'XMVI', R8, 0) 00003120 C 00003130 CALL VPSS (APUNIT, 'XMVI', R10, 0) 00003140 C 00003150 CALL VPSS (APUNIT, 'XMVI', R14, 3) 00003160 C 00003170 C TEST IF MORE THAN 3995 SAMPLES 00003180 C 00003190 CALL VPSS (APUNIT, 'XCI ', R1, 3995, 'GT39', 'GT ') 00003200 C 00003210 C IF NOT SET UP APPROPRIATE REGISTERS 00003220 C 00003230 CALL VPSS (APUNIT, 'XMV ', R4, R1) 00003240 C 00003250 CALL VPSS (APUNIT, 'XMV ', R6, R1) 00003260 C 00003270 CALL VPSS (APUNIT, 'XMV ', R7, R1) 00003280 C 00003290 CALL VPSS (APUNIT, 'SMV ', 0, 00003300 * 64, APWRK2, 0, 1, R1, 00003310 * 0, APONE) 00003320 C 00003330 CALL VPSS (APUNIT, 'XGO ', 'INTP') 00003340 C 00003350 C COME HERE IF MORE THAN 3995 SAMPLES 00003360 C 00003370 CALL VPSS (APUNIT, 'XID ', 'GT39') 00003380 C 00003390 C REGISTER 9 IS THE NUMBER OF SAMPLES LEFT TO PROCESS 00003400 C 00003410 CALL VPSS (APUNIT, 'XMV ', R9, R1) 00003420 C 00003430 CALL VPSS (APUNIT, 'XSB ', R9, R6) 00003440 C 00003450 C MOVE TOTAL NUMBER DONE SO FAR TO REG 5 TO 00003460 C USE AS AN INDEX INTO THE COMPUTED TIMES ARRAY 00003470 C 00003480 CALL VPSS (APUNIT, 'XMV ', R5, R6) 00003490 C 00003500 C ZERO WORK AREAS 00003510 C 00003520 CALL VPSS (APUNIT, 'ZMV ', 0, 00003530 * 64, APWRK2, 4, 1, R1) 00003540 C 00003550 C MAKE UPPER AND LOWER LIMIT EQUAL TO END TIME OF SECTION 00003560 C 00003570 CALL VPSS (APUNIT, 'SMV ', 0, 00003580 * 0, APLIMT, 3, 1, 00003590 * 32, APSLEN, R10) 00003600 C 00003610 C MAKE SECOND 'LIM' PARAMETER EQUAL TO ONE 00003620 C 00003630 CALL VPSS (APUNIT, 'SMV ', 0, 00003640 * 32, APLIMT, 1, 1, R2, 00003650 * 0, APONE) 00003660 C 00003670 C FIND TIMES PAST END OF SECTION 00003680 C 00003690 CALL VPSS (APUNIT, 'LIM ', 0, 00003700 * 96, APWRK2, 0, 1, R5, R9, 00003710 * 32, APWORK, 1, R5, 00003720 * 0, APLIMT) 00003730 C 00003740 C FIND FIRST TIME PAST END OF SECTION 00003750 C 00003760 CALL VPSS (APUNIT, 'MAX ', 0, 00003770 * 0, APLIMT, 00003780 * 96, APWRK2, 0, 1, R5, R9) 00003790 C 00003800 C MOVE NUMBER TO DO INTO REG 4 00003810 C 00003820 CALL VPSS (APUNIT, 'XMVS', APLIMT, 1, R2, R4) 00003830 C 00003840 C TEST IF NUMBER TO DO IS GREATER THAN NUMBER LEFT 00003850 C 00003860 CALL VPSS (APUNIT, 'XC ', R4, R9, 'GTNL', 'GT ') 00003870 C 00003880 C TEST IF NUMBER TO DO IS GREATER THAN ZERO 00003890 C 00003900 CALL VPSS (APUNIT, 'XCI ', R4, 0, 'FOUN', 'GT ') 00003910 C 00003920 C REG 4 < = ZERO OR REG 4 > NUMBER LEFT TO PROCESS 00003930 C 00003940 CALL VPSS (APUNIT, 'XID ', 'GTNL') 00003950 C 00003960 C MOVE NUMBER LEFT TO PROCESS TO REG 4 00003970 C 00003980 CALL VPSS (APUNIT, 'XMV ', R4, R9) 00003990 C 00004000 C CONTINUE WITH PROCESSING 00004010 C 00004020 CALL VPSS (APUNIT, 'XID ', 'FOUN') 00004030 C 00004040 C COMPUTE NEW TOTAL DONE 00004050 C 00004060 CALL VPSS (APUNIT, 'XAD ', R6, R4) 00004070 C 00004080 C MOVE LOWER INPUT TIME LIMIT (IN SAMPLES) TO APLIMT 00004090 C 00004100 CALL VPSS (APUNIT, 'XMVX', APLIMT, 1, 0, R8) 00004110 C 00004120 C CONVERT TO FLOATING POINT 00004130 C 00004140 CALL VPSS (APUNIT, 'VMC ', 0, 00004150 * 0, APWRK2, 2, 1, 00004160 * 2, APLIMT) 00004170 C 00004180 C CORRECT DISPLACEMENT TO TIME ZERO (NEGATIVE) 00004190 C 00004200 CALL VPSS (APUNIT, 'VMV ', 0, 00004210 * 0, APINTI, 1, 1, 00004220 * 48, APWRK2, 1, R2) 00004230 C 00004240 C CONVERT TO SECONDS 00004250 C 00004260 CALL VPSS (APUNIT, 'VEM ', 0, 00004270 * 0, APWRK2, 1, 1, 00004280 * 32, APWRK2, 1, R2, 00004290 * 0, APSAMP) 00004300 C 00004310 C MOVE TO FIRST THREE 'LIM' PARAMETERS 00004320 C 00004330 CALL VPSS (APUNIT, 'SMV ', 0, 00004340 * 0, APLIMT, 3, 1, 00004350 * 0, APWRK2) 00004360 C 00004370 C MOVE ONE TO SECOND 'LIM' PARAMETER 00004380 C 00004390 CALL VPSS (APUNIT, 'SMV ', 0, 00004400 * 32, APLIMT, 1, 1, R2, 00004410 * 0, APONE) 00004420 C 00004430 C MOVE ZERO TO FOURTH 'LIM' PARAMETER 00004440 C 00004450 CALL VPSS (APUNIT, 'ZMV ', 0, 00004460 * 32, APLIMT, 1, 1, R14) 00004470 C 00004480 C CHECK IF ANY TIMES BELOW LOWER TIME LIMIT 00004490 C 00004500 CALL VPSS (APUNIT, 'LIM ', 0, 00004510 * 96, APWRK2, 0, 1, R5, R4, 00004520 * 32, APWORK, 1, R5, 00004530 * 0, APLIMT) 00004540 C 00004550 C COME HERE TO DO ACTUAL INTERPOLATION 00004560 C 00004570 CALL VPSS (APUNIT, 'XID ', 'INTP') 00004580 C 00004590 C MOVE TIMES SO DON'T GET DESTROYED 00004600 C 00004610 CALL VPSS (APUNIT, 'VMV ', 0, 00004620 * 0, APLIMT, 3, 1, 00004630 * 32, APINTP, 1, R5) 00004640 C 00004650 C MOVE INT PARAMETERS INTO CORRECT AREA 00004660 C 00004670 CALL VPSS (APUNIT, 'VMV ', 0, 00004680 * 32, APINTP, 3, 1, R5, 00004690 * 0, APINTI) 00004700 C 00004710 C DO QUADRATIC INTERPOLATION 00004720 C 00004730 CALL VPSS (APUNIT, 'INT ', 0, 00004740 * 96, APVELI, 0, 1, R5, R4, 00004750 * 96, APTRAZ, 4, 1, R8, R7, 00004760 * 96, APINTP, 3, 1, R5, R4) 00004770 C 00004780 C RESTORE TIMES 00004790 C 00004800 CALL VPSS (APUNIT, 'VMV ', 0, 00004810 * 32, APINTP, 3, 1, R5, 00004820 * 0, APLIMT) 00004830 C 00004840 C COMPENSATE FOR VALUES POINTING ABOVE THE SECTION 00004850 C 00004860 CALL VPSS (APUNIT, 'VEM ', 0, 00004870 * 96, APVELI, 0, 1, R5, R4, 00004880 * 32, APVELI, 1, R5, 00004890 * 32, APWRK2, 1, R5) 00004900 C 00004910 C INCREMENT TRACE INDEX 00004920 C 00004930 CALL VPSS (APUNIT, 'XAD ', R8, R7) 00004940 C 00004950 C ALLOW FOR TWO SAMPLE OVERLAP 00004960 C 00004970 CALL VPSS (APUNIT, 'XSBI', R8, 2) 00004980 C 00004990 C INCREMENT SECTION NUMBER 00005000 C 00005010 CALL VPSS (APUNIT, 'XADI', R10, 1) 00005020 C 00005030 C CHECK IF THROUGH WITH TRACE 00005040 C 00005050 CALL VPSS (APUNIT, 'XC ', R6, R1, 'GT39', 'LT ') 00005060 C 00005070 C STEP 9 CHECK FOR MUTE APPLICATION 00005080 C 00005090 CALL VPSS (APUNIT, 'XMVS', 00005100 * APMTFL, 1, 0, R14) 00005110 C 00005120 C APPLY MUTE IF ASKED FOR, OTHERWISE GO TO 'CONT' 00005130 C 00005140 CALL VPSS (APUNIT, 'XCI ', R14, 0, 'CONT', 'EQ ') 00005150 C 00005160 C SET UP 1/(1+LIMDT)*TR FOR COMPARISON 00005170 C 00005180 C IF T0 <= 1/(1+LIMDT)*TR THEN ZERO 00005190 C 00005200 CALL VPSS (APUNIT, 'SMY ', 0, 00005210 * 64, APWORK, 0, 1, R1, 00005220 * 0, APWORK, 1, 00005230 * 0, APMUTE) 00005240 C 00005250 C SUBTRACT ABOVE FROM T ZERO 00005260 C 00005270 CALL VPSS (APUNIT, 'VES ', 0, 00005280 * 64, APWORK, 0, 1, R1, 00005290 * 0, APTZRO, 1, 00005300 * 8, APWORK) 00005310 C 00005320 C MOVE ZEROS INTO FOUR WORDS USED IN LIM 00005330 C 00005340 CALL VPSS (APUNIT, 'ZMV ', 0, 00005350 * 0, APLIMT, 4, 1) 00005360 C 00005370 C MOVE FLOATING POINT ONE TO SECOND WORD OF APLIMT 00005380 C 00005390 CALL VPSS (APUNIT, 'SMV ', 0, 00005400 * 32, APLIMT, 1, 1, R2, 00005410 * 0, APONE) 00005420 C 00005430 C SUBSTITUTE ZEROS WHERE MUTE, ONES WHERE NO MUTE 00005440 C 00005450 CALL VPSS (APUNIT, 'LIM ', 0, 00005460 * 64, APWORK, 0, 1, R1, 00005470 * 0, APWORK, 1, 00005480 * 0, APLIMT) 00005490 C 00005500 C FIND FIRST ONE 00005510 C 00005520 CALL VPSS (APUNIT, 'MAX ', 0, 00005530 * 0, APLIMT, 00005540 * 64, APWORK, 0, 1, R1) 00005550 C 00005560 C SET UP INDEXES 00005570 C 00005580 CALL VPSS (APUNIT, 'XMVS', 00005590 * APLIMT, 1, R2, R3) 00005600 C 00005610 CALL VPSS (APUNIT, 'XMV ', R2, R1) 00005620 C 00005630 CALL VPSS (APUNIT, 'XSB ', R2, R3) 00005640 C 00005650 C MOVE ONES INTO ARRAY 00005660 C 00005670 CALL VPSS (APUNIT, 'SMV ', 0, 00005680 * 96, APWORK, 0, 1, R3, R2, 00005690 * 0, APONE) 00005700 C 00005710 C APPLY MUTE 00005720 C 00005730 CALL VPSS (APUNIT, 'VEM ', 0, 00005740 * 64, APVELI, 0, 1, R1, 00005750 * 0, APVELI, 1, 00005760 * 0, APWORK) 00005770 C 00005780 C CONTROL IS PASSED TO HERE IF NO MUTE IS APPLIED 00005790 C 00005800 CALL VPSS (APUNIT, 'XID ', 'CONT') 00005810 C 00005820 C MOVE TO TEMPORARY OUTPUT AREA 00005830 C 00005840 CALL VPSS (APUNIT, 'VMV ', 0, 00005850 * 96, APSTOR, 0, 1, R11, R1, 00005860 * 0, APVELI) 00005870 C 00005880 C INCREMENT INDEX INTO OUTPUT AREA AND CHECK IF DONE 00005890 C 00005900 CALL VPSS (APUNIT, 'XAD ', R11, R1) 00005910 C 00005920 CALL VPSS (APUNIT, 'XC ', R11, R12, 'LOOP', 'LT ') 00005930 C 00005940 C STEP 10 TRANSFER DATA BACK TO 370 00005950 C 00005960 CALL VPSS (APUNIT, 'VGET', APOUT, NSDONE, APSTOR, 0) 00005970 C 00005980 C TRANSLATE THE COMMANDS 00005990 C 00006000 CALL VPSS (APUNIT, 'XLTE', APCVAN) 00006010 C 00006020 RETURN 00006030 END 00006040