CTITLESASTAT -- STATIC SHIFT OF SEISMIC TRACE IN ARRAY PROCESSOR 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DANIEL POLAK 00000020 CA DESIGNER DANIEL POLAK 00000030 CA LANGUAGE S/370 VPSS - FORTRAN 00000040 CA WRITTEN 04-03-80 00000050 C REVISED 06-03-80 DJP ZERO FIRST TWO TRACE VALUES FOR COR- 00000060 C RECT APPLICATION OF POSITIVE STATICS. 00000070 C REVISED 12-17-80 DJP CHANGED 'INT' ISTATE FROM 16 TO 0. 00000080 C REVISED 02-18-82 DJP CHANGED 'BLD' ISTATE FROM 3 TO 7 FOR 00000090 C CCW RETRANSLATION. 00000100 C REVISED 02-22-82 DJP CHANGED CCW TO INTEGER AND ADDED LCCW 00000110 C TO THE CALLING LIST. 00000120 C 00000130 CA 00000140 CA 00000150 CA CALL SASTAT (APUNIT, APWORK, STATIC, CCW, LCCW, CIT, TRACE, 00000160 CA NOSAMP) 00000170 CA 00000180 CA INPUT APUNIT = ARRAY PROCESSOR UNIT NUMBER I4 00000190 CA INPUT APWORK = PARAMETERS PASSED TO 3838 R4 &I4 00000200 CA OUTPUT STATIC = ADDRESS OF APRL FROM 'XLTE' FUNCTION I4 00000210 CA IN/OUT CCW = CHANNEL COMMAND WORD CHAIN I4 00000220 CA IN LCCW = LENGTH OF THE CCW I4 00000230 CA IN/OUT CIT = CONTROL INFORMATION TABLE R4 00000240 CA IN/OUT TRACE = SEISMIC TRACE R4 00000250 CA INPUT NOSAMP = NUMBER OF SAMPLES I4 00000260 CA 00000270 CA THIS SUBROUTINE WILL APPLY A STATIC SHIFT TO A SEISMIC TRACE 00000280 CA IN THE 3838 ARRAY PROCESSOR. A POSITIVE STATIC PUSHES THE 00000290 CA TRACE AWAY FROM TIME ZERO WHILE A NEGATIVE STATIC PULLS THE 00000300 CA TRACE TOWARD TIME ZERO. 00000310 CA 00000320 C EJECT 00000330 CD 00000340 CD WARNIER DIAGRAM 00000350 CD --------------- 00000360 CD 00000370 CD |-- 00000380 CD | BEGIN TASK: 'BLD' 00000390 CD | (1) 00000400 CD | 00000410 CD | SEND PARAMETERS & 00000420 CD | TRACE (1) 00000430 CD | 00000440 CD | |-- 00000450 CD APPLY STATIC --| | PERFORM 00000460 CD IN AP 3838 | APPLY STATIC ---| 00000470 CD | (1) | PERFORM 00000480 CD | |-- 00000490 CD | RECEIVE TRACE 00000500 CD | (1) 00000510 CD | 00000520 CD | END TASK: 'XLTE' 00000530 CD |-- (1) 00000540 CD 00000550 CD 00000560 CD |-- 00000570 CD | INITIALIZE WORK 00000580 CD | ARRAYS (1) 00000590 CD | 00000600 CD | GENERATE A RAMP 00000610 CD | (1) 00000620 CD | 00000630 CD GENERATE INTER- | CONVERT TO SECONDS 00000640 CD POLATION TIMES---| (1) 00000650 CD | 00000660 CD | SHIFT RAMP BY STATIC 00000670 CD | TO GET INTER. TIMES 00000680 CD | (1) 00000690 CD | 00000700 CD | LIMIT OUTPUT LENGTH 00000710 CD | TO INPUT LENGTH 00000720 CD |-- (1) 00000730 CD 00000740 CD 00000750 CD |-- 00000760 CD | INITIALIZE |-- 00000770 CD | REGISTERS (1) | SET REGISTERS 00000780 CD | | (1) 00000790 CD | # SAMPLES < | 00000800 CD | OR = 3995 ---| PERFORM , , AND 00000810 CD | (0,1) |-- 00000820 CD | 00000830 CD | |-- 00000840 CD QUADRATIC ---| | LIMIT SECTION FOR INTER- 00000850 CD INTERPOLATION | | POLATION TO AT MOST 3999 00000860 CD | EOR | SAMPLES (1) 00000870 CD | | 00000880 CD | | 00000890 CD | | DETERMINE STARTING POINT 00000900 CD | | FOR INTERPOLATION (1) 00000910 CD | # SAMPLES > | 00000920 CD | 3995 (0,N) ---| 00000930 CD |-- | INTERPOLATE (1) 00000940 CD | |-- 00000950 CD | ENTIRE TRACE NOT --| PERFORM 00000960 CD | INTERPOLATED (0,1) |-- 00000970 CD | 00000980 CD | EOR 00000990 CD | 00001000 CD | ENTIRE TRACE INTERPOLATED 00001010 CD |-- (0,1) 00001020 CD EJECT 00001030 C 00001040 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS 00001050 C 00001060 C APIN = ADDRESS OF INPUT TRACE I4 00001070 C AP16 = ADDRESS OF FLOATING POINT 16 I4 00001080 C APONE = ADDRESS OF FLOATING POINT ONE I4 00001090 C APOUT = ADDRESS OF OUTPUT TRACE I4 00001100 C APINTI = ADDRESS OF 'INT' PARAMETERS I4 00001110 C APINTP = ADDRESS OF 'INT' WORK PARAMETERS I4 00001120 C APNSAM = ADDRESS OF NUMBER OF SAMPLES I4 00001130 C APNSFT = ADDRESS OF NUMBER OF SAMPLES TO SHIFT I4 00001140 C APRLEN = ADDRESS OF RECORD LENGTH IN SECONDS I4 00001150 C APSAMP = ADDRESS OF SAMPLE RATE IN SECONDS I4 00001160 C APSTAT = ADDRESS OF STATIC SHIFT IN SECONDS I4 00001170 C APUNIT = ARRAY PROCESSOR UNIT NUMBER I4 00001180 C APWORK = PARAMETERS AND TRACE IN HOST 370 R4 & I4 00001190 C APWRK1 = ADDRESS OF WORK ARRAY I4 00001200 C APWRK2 = ADDRESS OF WORK ARRAY I4 00001210 C NOSAMP = NUMBER OF SAMPLES IN THE SEISMIC TRACE I4 00001220 C 00001230 C ====================================================== 00001240 C REGISTERS 00001250 C 00001260 C REG 1 NOSAMP 00001270 C 00001280 C REG 2 WORK REGISTER 00001290 C 00001300 C REG 3 WORK REGISTER 00001310 C 00001320 C REG 4 NUMBER OF OUTPUT SAMPLES TO INTERPOLATE AT ONE TIME 00001330 C 00001340 C REG 5 INDEX OF STARTING INTERPOLATION POINT FOR OUTPUT TRACE 00001350 C 00001360 C REG 6 TOTAL NUMBER OF SAMPLES INTERPOLATED 00001370 C 00001380 C REG 7 NUMBER OF SAMPLES LEFT TO INTERPOLATE 00001390 C 00001400 C REG 8 INDEX OF STARTING INTERPOLATION POINT FOR INPUT TRACE 00001410 C 00001420 C REG 9 NUMBER OF INPUT SAMPLES TO INTERPOLATE AT ONE TIME 00001430 C 00001440 C REG 10 NUMBER OF SAMPLES TO BE SHIFTED 00001450 C 00001460 C ====================================================== 00001470 C 00001480 SUBROUTINE SASTAT (APUNIT, APWORK, STATIC, CCW, LCCW, CIT, TRACE, 00001490 * NOSAMP) 00001500 C 00001510 IMPLICIT INTEGER (A-Z) 00001520 C 00001530 C ARRAYS IN THE PARAMETER LIST 00001540 C 00001550 REAL APWORK (1) 00001560 REAL CIT (1) 00001570 REAL TRACE (1) 00001580 INTEGER CCW (LCCW) 00001590 C 00001600 C INTEGER CONSTANTS -- LOCAL 00001610 C 00001620 INTEGER R1 /1/ 00001630 INTEGER R2 /2/ 00001640 INTEGER R3 /3/ 00001650 INTEGER R4 /4/ 00001660 INTEGER R5 /5/ 00001670 INTEGER R6 /6/ 00001680 INTEGER R7 /7/ 00001690 INTEGER R8 /8/ 00001700 INTEGER R9 /9/ 00001710 INTEGER R10 /10/ 00001720 C 00001730 C CREATE 3838 BULK STORAGE ADDRESSES 00001740 C 00001750 APNSAM = 1 00001760 APSAMP = APNSAM + 1 00001770 APSTAT = APSAMP + 1 00001780 APNSFT = APSTAT + 1 00001790 APRLEN = APNSFT + 1 00001800 APONE = APRLEN + 4 00001810 AP16 = APONE + 1 00001820 APINTI = AP16 + 1 00001830 APLEN = APINTI + 2 00001840 APIN = APINTI + 3 00001850 APOUT = APIN + NOSAMP + 4 00001860 APINTP = APOUT + NOSAMP 00001870 APWRK1 = APINTP + 3 00001880 APWRK2 = APWRK1 + NOSAMP 00001890 C 00001900 C BUILD THE 3838 PROGRAM 00001910 C 00001920 CALL VPSS (APUNIT, 'BLD ', 7, CCW, LCCW, CIT, 350) 00001930 C 00001940 C SEND PARAMETERS AND TRACE TO 3838 00001950 C 00001960 CALL VPSS (APUNIT, 'VPUT', APWORK, APLEN, APNSAM, 0) 00001970 C 00001980 CALL VPSS (APUNIT, 'VPUT', TRACE, NOSAMP, APIN, 0) 00001990 C 00002000 CALL VPSS (APUNIT, 'XMVS', APNSAM, 1, 0, R1) 00002010 C 00002020 CALL VPSS (APUNIT, 'XMVS', APNSFT, 1, 0, R10) 00002030 C 00002040 CALL VPSS (APUNIT, 'XMVI', R2, 1) 00002050 C 00002060 C APPLY STATIC SHIFT IN TWO STAGES 00002070 C 1. GENERATE INTERPOLATION TIMES 00002080 C 2. PERFORM QUADRATIC INTERPOLATION ON INPUT TRACE 00002090 C 00002100 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00002110 C C00002120 C GENERATE INTERPOLATION TIMES C00002130 C C00002140 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00002150 C 00002160 C INITIALIZE WORK ARRAYS 00002170 C 00002180 CALL VPSS (APUNIT, 'SMV ', 0, 00002190 * 64, APOUT, 1, 1, R1, 00002200 * 0 , APONE) 00002210 C 00002220 CALL VPSS (APUNIT, 'SMV ', 0, 00002230 * 0, APOUT, 1, 1, 00002240 * 0, AP16) 00002250 C 00002260 CALL VPSS (APUNIT, 'ZMV ', 0, 00002270 * 64, APWRK1, 0, 1, R1) 00002280 C 00002290 C GENERATE A RAMP FUNCTION 00002300 C 00002310 CALL VPSS (APUNIT, 'REC ', 0, 00002320 * 64, APWRK1, 0, 1, R1, 00002330 * 32, APOUT, 1, R2, 00002340 * 0, APOUT) 00002350 C 00002360 CALL VPSS (APUNIT, 'SDIV', 0, 00002370 * 0, AP16, 1, 1, 00002380 * 0, AP16, 1, 00002390 * 0, APONE) 00002400 C 00002410 CALL VPSS (APUNIT, 'SMY ', 0, 00002420 * 64, APWRK1, 0, 1, R1, 00002430 * 0, APWRK1, 1, 00002440 * 0, AP16) 00002450 C 00002460 C CONVERT RAMP TO SECONDS WITH THE SAMPLE INTERVAL 00002470 C AS THE INCREMENT BETWEEN POINTS 00002480 C 00002490 CALL VPSS (APUNIT, 'SMY ', 0, 00002500 * 64, APWRK1, 0, 1, R1, 00002510 * 0, APWRK1, 1, 00002520 * 0, APSAMP) 00002530 C 00002540 C SHIFT RAMP BY STATIC TO GET INTERPOLATION TIMES 00002550 C 00002560 CALL VPSS (APUNIT, 'SSUM', 0, 00002570 * 0, APSTAT, 1, 1, 00002580 * 0, APSTAT, 1, 00002590 * 16, APSAMP) 00002600 C 00002610 CALL VPSS (APUNIT, 'SSUM', 0, 00002620 * 64, APWRK1, 0, 1, R1, 00002630 * 0, APWRK1, 1, 00002640 * 0, APSTAT) 00002650 C 00002660 C LIMIT OUTPUT TRACE RECORD LENGTH TO 00002670 C THE SAME LENGTH AS THE INPUT TRACE 00002680 C 00002690 CALL VPSS (APUNIT, 'LIM ', 0, 00002700 * 64, APWRK1, 0, 1, R1, 00002710 * 0, APWRK1, 1, 00002720 * 0, APRLEN) 00002730 C 00002740 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00002750 C C00002760 C QUADRATIC INTERPOLATION C00002770 C C00002780 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC00002790 C 00002800 C ZERO OUT OUTPUT ARRAY 00002810 C 00002820 CALL VPSS (APUNIT, 'ZMV ', 0, 00002830 * 64, APOUT, 0, 1, R1) 00002840 C 00002850 C ZERO WORK AREA 00002860 C 00002870 CALL VPSS (APUNIT, 'ZMV ', 0, 00002880 * 0, APWRK2, 4) 00002890 C 00002900 C ZERO OUT INT PARAMETERS TO AVOID UNDERFLOW 00002910 C 00002920 CALL VPSS (APUNIT, 'ZMV ', 0, 00002930 * 0, APINTP, 3) 00002940 C 00002950 C ZERO OUT FOUR WORDS PAST END OF INPUT TRACE 00002960 C 00002970 CALL VPSS (APUNIT, 'ZMV ', 0, 00002980 * 32, APIN, 4, 1, R1) 00002990 C 00003000 C ZERO FIRST TWO TRACE VALUES FOR CORRECT 00003010 C APPLICATION OF POSITIVE STATICS 00003020 C 00003030 CALL VPSS (APUNIT, 'ZMV ', 0, 00003040 * 0, APIN, 2) 00003050 C 00003060 C INITIALIZE REGISTERS 00003070 C 00003080 CALL VPSS (APUNIT, 'XMVI', R3, 2) 00003090 C 00003100 CALL VPSS (APUNIT, 'XMVI', R5, 0) 00003110 C 00003120 CALL VPSS (APUNIT, 'XMVI', R6, 0) 00003130 C 00003140 CALL VPSS (APUNIT, 'XMVI', R8, 0) 00003150 C 00003160 C TEST IF MORE THAN 3995 SAMPLES 00003170 C 00003180 CALL VPSS (APUNIT, 'XCI ', R1, 3995, 'GT39', 'GT ') 00003190 C 00003200 C IF NOT, SET UP APPROPRIATE REGISTERS . . . 00003210 C 00003220 CALL VPSS (APUNIT, 'XMV ', R4, R1) 00003230 C 00003240 CALL VPSS (APUNIT, 'XMV ', R6, R1) 00003250 C 00003260 CALL VPSS (APUNIT, 'XMV ', R9, R1) 00003270 C 00003280 C . . . AND BRANCH TO QUADRATIC INTERPOLATION 00003290 C 00003300 CALL VPSS (APUNIT, 'XGO ', 'QUAD') 00003310 C 00003320 CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX00003330 C 00003340 C COME HERE IF MORE THAN 3995 SAMPLES 00003350 C 00003360 CALL VPSS (APUNIT, 'XID ', 'GT39') 00003370 C 00003380 C SET NUMBER FOR INTERPOLATION TO 3994 00003390 C 00003400 CALL VPSS (APUNIT, 'XMVI', R9, 3994) 00003410 C 00003420 C DETERMINE NUMBER OF OUTPUT POINTS 00003430 C 00003440 CALL VPSS (APUNIT, 'XMV ', R4, R9) 00003450 C 00003460 CALL VPSS (APUNIT, 'XSB ', R4, R10) 00003470 C 00003480 C REGISTER 7 IS THE NUMBER OF SAMPLES LEFT 00003490 C TO INTERPOLATE 00003500 C 00003510 CALL VPSS (APUNIT, 'XMV ', R7, R1) 00003520 C 00003530 CALL VPSS (APUNIT, 'XSB ', R7, R6) 00003540 C 00003550 C MOVE TOTAL NUMBER DONE SO FAR TO REG 5 TO USE 00003560 C AS AN INDEX INTO THE INTERPOLATION TIMES ARRAY 00003570 C 00003580 CALL VPSS (APUNIT, 'XMV ', R5, R6) 00003590 C 00003600 C TEST IF NUMBER TO DO IS LESS THAN NUMBER LEFT 00003610 C 00003620 CALL VPSS (APUNIT, 'XC ', R4, R7, 'TOTL', 'LT ') 00003630 C 00003640 C RESET NUMBER TO DO TO THE NUMBER LEFT 00003650 C 00003660 CALL VPSS (APUNIT, 'XMV ', R4, R7) 00003670 C 00003680 C CONTINUE WITH PROCESSING 00003690 C 00003700 CALL VPSS (APUNIT, 'XID ', 'TOTL') 00003710 C 00003720 C COMPUTE THE NUMBER OF SAMPLES INTERPOLATED 00003730 C 00003740 CALL VPSS (APUNIT, 'XAD ', R6, R4) 00003750 C 00003760 CXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX00003770 C 00003780 C 00003790 C DETERMINE THE STARTING POINT FOR INTERPOLATION 00003800 C IN THE INPUT TRACE 00003810 C 00003820 CALL VPSS (APUNIT, 'XID ', 'QUAD') 00003830 C 00003840 C MOVE THE CURRENT STARTING POINT FOR 00003850 C INTERPOLATION TO BULK STORAGE 00003860 C 00003870 CALL VPSS (APUNIT, 'XMVX', APWRK2, 1, R3, R8) 00003880 C 00003890 C CONVERT TO FLOATING POINT 00003900 C 00003910 CALL VPSS (APUNIT, 'VMC ', 0, 00003920 * 0, APWRK2, 2, 1, 00003930 * 34, APWRK2, R3) 00003940 C 00003950 C CORRECT STARTING POINT DISPLACEMENT TO 00003960 C TIME ZERO (NEGATIVE) 00003970 C 00003980 CALL VPSS (APUNIT, 'VMV ', 0, 00003990 * 0, APINTI, 1, 1, 00004000 * 48, APWRK2, 1, R2) 00004010 C 00004020 C MOVE TIMES SO DON'T GET DESTROYED 00004030 C 00004040 CALL VPSS (APUNIT, 'VMV ', 0, 00004050 * 0, APWRK2, 3, 1, 00004060 * 32, APINTP, 1, R5) 00004070 C 00004080 C MOVE INT PARAMETERS INTO CORRECT AREA 00004090 C 00004100 CALL VPSS (APUNIT, 'VMV ', 0, 00004110 * 32, APINTP, 3, 1, R5, 00004120 * 0, APINTI) 00004130 C 00004140 C DO QUADRATIC INTERPOLATION 00004150 C 00004160 CALL VPSS (APUNIT, 'INT ', 0, 00004170 * 96, APOUT , 0, 1, R5, R4, 00004180 * 96, APIN , 4, 1, R8, R9, 00004190 * 96, APINTP, 3, 1, R5, R4) 00004200 C 00004210 C REPLACE TIMES 00004220 C 00004230 CALL VPSS (APUNIT, 'VMV ', 0, 00004240 * 32, APINTP, 3, 1, R5, 00004250 * 0, APWRK2) 00004260 C 00004270 C DETERMINE STARTING POINT IN INPUT TRACE 00004280 C FOR FURTHER INTERPOLATION 00004290 C 00004300 CALL VPSS (APUNIT, 'XAD ', R8, R9) 00004310 C 00004320 C ALLOW FOR TWO SAMPLE OVERLAP 00004330 C 00004340 CALL VPSS (APUNIT, 'XSBI', R8, 2) 00004350 C 00004360 C CHECK IF INTERPOLATON IS COMPLETE 00004370 C 00004380 CALL VPSS (APUNIT, 'XC ', R6, R1, 'GT39', 'LT ') 00004390 C 00004400 C RETRIEVE TRACE FROM ARRAY PROCESSOR 00004410 C 00004420 CALL VPSS (APUNIT, 'VGET', TRACE, NOSAMP, APOUT, 0) 00004430 C 00004440 CALL VPSS (APUNIT, 'XLTE', STATIC) 00004450 RETURN 00004460 END 00004470