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