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