SAOMNA TITLE 'SAOMNA -- PERFORMS REVERSE NORMAL MOVEOUT' 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** *TITLESAOMNA -- PERFORMS REVERSE NORMAL MOVEOUT (ASSEMBLER) 00000200 *A AUTHOR HENRY LAVALLET 00000300 *A DESIGNER DAVID THOMPSON 00000400 *A LANGUAGE S/370 ASSEMBLER F 00000500 *A WRITTEN 04-25-80 00000600 * REVISED MO-DA-YR BY PROGRAMMER FOR REASON 00000700 *A 00000800 *A 00000900 *A CALL SAOMNA (T0, V, I0, N0, IX, X, KEY, SR, TX) 00001000 *A INPUT T0 = ZERO OFFSET TRACE R4 00001100 *A INPUT V = VELOCITY ARRAY (UNIT DIST/ SEC.) R4 00001200 *A INPUT I0 = SAMPLE NO. (TIME ZERO) FOR T0(1) I4 00001300 *A INPUT N0 = NO. OF SAMPLES IN T0 AND V I4 00001400 *A INPUT IX = SAMPLE NO. (TIME ZERO) FOR TX(1) I4 00001500 *A INPUT NX = NO.OF SAMPLES IN TX I4 00001600 *A INPUT X = OFFSET DISTANCE R4 00001700 *A INPUT KEY = COMPRESSION RATIO SCALING I4 00001800 *A 0 = NO SCALING ( PROGRAM ASSUMES KEY = 0) 00001900 *A INPUT SR = SAMPLE INTERVAL (SECS.) R4 00002000 *A OUTPUT TX = OUTPUT TRACE R4 00002100 *A 00002200 *A THIS SUBROUTINE PERFORMS REVERSE NORMAL MOVEOUT AND IS AN 00002300 *A ASSEMBLER LANGUAGE RE-WRITE OF FORTRAN SUBROUTINE SAOMN. 00002400 *A 00002500 * 00002600 EJECT 00002700 *********************************************************************** 00002800 * * 00002900 * REGISTER EQUATES * 00003000 * * 00003100 *********************************************************************** 00003200 COPY S1REG 00003300 EJECT 00003400 *********************************************************************** 00003500 * * 00003600 * PROGRAM INITIALIZATION * 00003700 * * 00003800 *********************************************************************** 00003900 SPACE 1 00004000 SAOMNA CSECT 00004100 STM R14,R12,12(R13) SAVE REGISTERS 00004200 USING SAOMNA,R15 00004300 LA R15,SAVE1 00004400 ST R15,8(0,R13) SAVE SAVE AREA ADDRESS - CHAIN 00004500 ST R13,4(0,R15) SAVE BASE REGISTER - CHAIN 00004600 LR R13,R15 LOAD BASE REGISTER 00004700 DROP R15 00004800 USING SAVE1,R13 SET BASE REG SAME AS REG SAVE AREA 00004900 B SAVE1+72 BRANCH AROUND NAME AND SAVE AREA 00005000 CNOP 0,4 00005100 DC AL1(7),CL7'SAOMNA ' 00005200 SAVE1 DS 18F SAVE AREA 00005300 SPACE 1 00005400 *********************************************************************** 00005500 * * 00005600 * PROGRAM MAINLINE * 00005700 * * 00005800 *********************************************************************** 00005900 SPACE 2 00006000 LM R2,R11,0(R1) LOAD ADDRESSES OF SUBR PARAMETERS 00006100 STM R2,R11,ADCONS AND SAVE FOR LATER REFERENCE 00006200 SPACE 1 00006300 ** COMPUTATION OF OFFSET EQUIVALENT OF FINAL TIME IN T0 00006400 SPACE 1 00006500 L R5,0(R5) LOAD VALUE OF N0 00006600 LR R12,R5 DECREMENT N0 BY 1 TO GET 00006700 BCTR R12,0 VALUE MM AND SAVE IN REG 12 00006800 LR R14,R12 00006900 SLL R14,2 MULTIPLY BY 4 TO GET ADDRESS 00007000 LE FR0,0(R14,R3) LOAD V(N0) 00007100 ME FR0,0(,R10) MULTIPLY V(N0) BY VALUE OF SR 00007200 LE FR4,0(R8) LOAD VALUE OF X AND 00007300 DER FR4,FR0 DIVIDE BY ( V(N0) * SR ) 00007400 STE FR4,FJ SAVE AS VALUE FJ 00007500 L R1,0(R4) LOAD VALUE OF I0 00007600 BCTR R1,0 DECREMENT BY 1 TO GET I0M AND 00007700 ST R1,I0M SAVE FOR LATER USE 00007800 AR R1,R5 ADD N0 TO GET INITIAL VALUE 00007900 ST R1,K OF K (INTEGER) AND SAVE 00008000 L R14,0(R6) LOAD VALUE OF IX 00008100 BCTR R14,0 DECREMENT BY 1 TO GET VALUE OF IXM 00008200 ST R14,IXM SAVE FOR LATER CALCULATIONS 00008300 SPACE 1 00008400 ** CALCULATE FLT FORM OF K FOR NEXT CALCULATION - NEWTON RHAPSON 00008500 ** SQUARE ROOT ESTIMATION 00008600 SPACE 1 00008700 ST R1,CV2 00008800 LD FR2,CV1 00008900 AD FR2,=D'0' 00009000 STE FR2,KFLT SAVE FLT FORM OF K 00009100 CER FR4,FR2 IF VALUE FJ LT KFLT MAKE FJ = KFLT 00009200 BC 10,LOC1 00009300 STE FR2,FJ FJ = KFLT 00009400 LOC1 MER FR4,FR4 TAKE PREVIOUS CALC OF FJ (OR H) AND 00009500 MER FR2,FR2 SQUARE IT ,DO SAME FOR K AND SET 00009600 AER FR2,FR4 H = H * H + K * K 00009700 STE FR2,H SAVE VALUE H 00009800 DE FR2,FJ H/FJ = HDFJ 00009900 STE FR2,HDFJ 00010000 SPACE 1 00010100 ** LOOP BACK TO HERE IF MORE ITERATIONS NEEDED FOR SQUARE ROOT 00010200 SPACE 1 00010300 LOC2 DS 0H 00010400 LE FR0,HDFJ 00010500 AE FR0,FJ CALCULATE NEW VALUE OF FJ 00010600 ME FR0,FK5T FJ = .5*(FJ+HDFJ) 00010700 STE FR0,FJ 00010800 LE FR6,H AND NEW VALUE OF HDFJ 00010900 DER FR6,FR0 HDFJ = H/FJ 00011000 STE FR6,HDFJ 00011100 SPACE 1 00011200 ** TEST FOR MORE ITERATIONS ON SQUARE ROOT 00011300 SPACE 1 00011400 SER FR0,FR6 IF (ABS(FJ-HDFJ)-DDT) LE 0 00011500 LPER FR0,FR0 MORE ITERATIONS NEEDED 00011600 CE FR0,DDT 00011700 BC 3,LOC2 GO DO SOME MORE 00011800 SPACE 1 00011900 ** SET FJH = FJL = COMPUTED FINAL TIME AND 00012000 ** INITIALIZE J AT BOTTOM OF T0 00012100 SPACE 1 00012200 ST R5,J SET J = VALUE OF N0 00012300 MVC FJH(4),FJ SET FJH = COMPUTED FINAL TIME AND 00012400 MVC FJL(4),FJ SET FJL = COMPUTED FINAL TIME 00012500 SPACE 2 00012600 ** MAIN LOOP - WORK FROM BOTTOM TO TOP OF TX 00012700 SPACE 2 00012800 L R7,0(R7) LOAD VALUE OF NX AS LOOP COUNTER 00012900 L R9,0(R6) LOAD VALUE IX TO COMPUTE VALUE OF M 00013000 AR R9,R7 M = NX + IX 00013100 BCTR R9,0 I = M - 1 TO START LOOP 00013200 ST R9,I SAVE AS INTEGER THEN 00013300 ST R9,CV2 SET UP INITIAL INDEX TO SAVE 00013400 S R9,IXM COMPUTED VALUES IN TX 00013500 BCTR R9,0 00013600 ST R9,NDX 00013700 LD FR6,CV1 NOW CONVERT I TO FLT FORM FOR 00013800 AD FR6,=D'0' LATER CALCULATIONS AND CARRY IT 00013900 STE FR6,MFLT IN FR6 THRUOUT LOOP 00014000 LE FR6,MFLT BE SURE ITS NORMALIZED 00014100 ST R5,CV2 R5 = J LETS CONVERT J TO FLT FORM 00014200 LD FR4,CV1 FOR CALCULATIONS 00014300 AD FR4,=D'0' 00014400 STE FR4,JFLT SAVE FOR LATER CALCULATIONS 00014500 MVC CV2(4),I0M CONVERT VALUE I0M TO FLT. PT. 00014600 * FOR LATER CALCULATIONS 00014700 LD FR4,CV1 00014800 AD FR4,=D'0' 00014900 STE FR4,I0MFLT SAVE I0MFLT FOR LATER 00015000 SPACE 1 00015100 ** START OF MAIN LOOP - IS CURRENT SAMPLE LT OR GTE UPPER BRACKET FJH 00015200 SPACE 1 00015300 LOOP DS 0H 00015400 CE FR6,FJH IF (I-FJH) 60,140,140 00015500 BC 10,LOC140 00015600 SPACE 1 00015700 ** IS CURRENT SAMPLE LT OR GTE LOWER BRACKET FJL 00015800 SPACE 1 00015900 LOC60 CE FR6,FJL IF (I-FJL) 70,130,130 00016000 BC 10,LOC130 00016100 LOC70 MVC FJH(4),FJL IF SAMPLE LT LOWER BRACKET 00016200 * SET NEW UPPER BRACKET TO OLD LOWER 00016300 SPACE 1 00016400 ** TRY NEW J - ARE WE AT TOP OF T0 ( GO TO LOC90 IF NOT AT TOP ) 00016500 SPACE 1 00016600 LOC80 BCTR R5,0 IF (J-1) 140,140,90 00016700 LTR R5,R5 00016800 BC 12,LOC140 00016900 SPACE 1 00017000 ** DECREMENT J AND COMPUTE ITS OFFSET EQUIVALENT 00017100 SPACE 1 00017200 LOC90 L R4,I0M LOAD VALUE OF I0M (I0-1) 00017300 ST R5,J SAVE J = J-1 00017400 LE FR0,JFLT ALSO SET FLT FORM OF J = J-1 00017500 SE FR0,FK1 00017600 STE FR0,JFLT 00017700 AR R4,R5 K = I0M + J 00017800 ST R4,K 00017900 SPACE 1 00018000 ** CALCULATE H = X / (V(J) * SR) 00018100 SPACE 1 00018200 BCTR R5,0 00018300 SLL R5,2 MULT VALUE J BY 4 TO GET ADDRESS 00018400 LE FR0,0(R5,R3) LOAD VALUE OF V(J) 00018500 ME FR0,0(,R10) V(J) * SR 00018600 LE FR4,0(R8) LOAD VALUE X 00018700 DER FR4,FR0 X / (V(J) * SR) 00018800 ST R4,CV2 NOW FLT VALUE OF K 00018900 LD FR2,CV1 00019000 AD FR2,=D'0' 00019100 STE FR2,KFLT 00019200 SPACE 1 00019300 ** CALCULATE H = K * K + H * H 00019400 SPACE 1 00019500 MER FR2,FR2 K * K 00019600 MER FR4,FR4 H * H 00019700 AER FR2,FR4 NOW ADD TWO VALUES AND 00019800 STE FR2,H SAVE AS VALUE OF H 00019900 DE FR2,FJ COMPUTE HDFJ = H / FJ 00020000 STE FR2,HDFJ AND SAVE 00020100 SPACE 1 00020200 ** SQUARE ROOT CALCULATION OF OFFSET EQUIVALENT 00020300 SPACE 1 00020400 LOC100 DS 0H 00020500 AE FR2,FJ COMPUTE NEW FJ = .5 * (FJ+HDFJ) 00020600 ME FR2,FK5T 00020700 STE FR2,FJ 00020800 LE FR2,H COMPUTE NEW HDFJ = H / FJ 00020900 DE FR2,FJ 00021000 STE FR2,HDFJ 00021100 SPACE 1 00021200 ** TEST SUFFICIENT ACCURACY OF SQUARE ROOT 00021300 SPACE 1 00021400 LE FR0,FJ IF (ABS (FJ-HDFJ) - DDT) 110,110,100 00021500 SER FR0,FR2 FJ - HDFJ 00021600 LPER FR0,FR0 GET ABSOLUTE VALUE 00021700 CE FR0,DDT 00021800 BC 3,LOC100 00021900 SPACE 1 00022000 ** FJ IS OFFSET EQUIVALENT OF J. TEST IF OFFSET POINTER IS 00022100 ** BELOW OR ABOVE FJ 00022200 SPACE 1 00022300 LOC110 DS 0H 00022400 CE FR6,FJ IF (I - FJ) 120,130,130 00022500 BC 10,LOC130 00022600 SPACE 1 00022700 ** BELOW FJ, RESET UPPER BRACKET TO FJ AND TRY SMALLER J 00022800 SPACE 1 00022900 LOC120 DS 0H 00023000 MVC FJH(4),FJ SET FJH = FJ 00023100 L R5,J 00023200 B LOC80 00023300 SPACE 1 00023400 ** DESIRED POINT IS BRACKETED, COMPUTE COMPRESSION RATIO 00023500 SPACE 1 00023600 LOC130 DS 0H 00023700 MVC FJL(4),FJ SET FJL = FJ 00023800 LE FR2,FJH COMPUTE FACTOR = 1. / (FJH-FJL) 00023900 SE FR2,FJL FJH - FJL 00024000 LE FR4,FK1 00024100 DER FR4,FR2 1. / (FJH-FJL) 00024200 STE FR4,FACTOR SAVE VALUE FACTOR 00024300 SPACE 1 00024400 ** COMPUTE FRACTIONAL SAMPLE WANTED IN T0 00024500 ** COMPUTE QJ = J - (FJH - I) * FACTOR + 1. 00024600 SPACE 1 00024700 LE FR0,FJH LOAD VALUE OF FJH 00024800 SER FR0,FR6 FJH - I (I SAME AS MFLT OR FR6) 00024900 MER FR0,FR4 MULTIPLY BY FACTOR 00025000 LE FR2,JFLT LOAD VALUE J (FLT FORM) 00025100 SER FR2,FR0 J - (FJH-I) 00025200 AE FR2,FK1 AND ADD 1. 00025300 B LOC150 00025400 SPACE 1 00025500 ** SPECIAL CALCULATION FOR DESIRED SAMPLE WHEN AT TOP OF T0 00025600 ** QJ = I * (J+I0M)/FJL - I0M 00025700 SPACE 1 00025800 LOC140 DS 0H 00025900 LE FR2,JFLT LOAD VALUE J (FLT FORM) 00026000 AE FR2,I0MFLT J + I0M 00026100 MER FR2,FR6 (J + I0M) * I 00026200 LE FR0,FJL LOAD VALUE FJL 00026300 DER FR2,FR0 AND DIVIDE INTO (I*(J+I0M)) 00026400 SE FR2,I0MFLT NOW SUBTRACT I0M TO GET QJ 00026500 SPACE 1 00026600 ** COMPUTE NEXT LOWER INTEGER TO DESIRED SAMPLE 00026700 SPACE 1 00026800 LOC150 DS 0H 00026900 STE FR2,QJ SAVE AS VALUE QJ OR (L FLT FORM) 00027000 SDR FR0,FR0 CONVERT L TO INTEGER FORM FOR 00027100 LER FR0,FR2 CALCULATIONS 00027200 AD FR0,CV3 00027300 STD FR0,CV5 00027400 L R1,CV6 CV6 = L (INTEGER FORM) 00027500 LTR R1,R1 IS NEXT LOWER INTEGER BELOW 1 00027600 BC 3,LOC170 IF (L) 160,160,170 BIF NOT LOWER 00027700 LOC160 LA R1,1 YES IT IS LOWER, SET L = 1 00027800 ST R1,CV2 SAVE FOR LATER CONVERSION TO FL FORM 00027900 SPACE 1 00028000 ** INTEGER IS GTE 1. IS INTEGER GTE LAST ELEMENT OF T0 00028100 SPACE 1 00028200 LOC170 DS 0H 00028300 CR R1,R12 IF (L-MM) 190,190,180 R12 = MM 00028400 BC 12,LOC190 BIF NOT 00028500 SPACE 1 00028600 ** INTEGER AT OR BEYOND END OF T0, SET TO NEXT TO LAST 00028700 SPACE 1 00028800 LOC180 DS 0H 00028900 ST R12,CV2 SAVE MM AS VALUE L (INTEGER FORM BUT 00029000 LOC190 DS 0H 00029100 LD FR2,CV1 CONVERT TO FLT FORM AND COMPUTE 00029200 AD FR2,=D'0' 00029300 LE FR0,QJ FQ = QJ - L 00029400 SER FR0,FR2 00029500 STE FR0,FQ SAVE FQ 00029600 SPACE 1 00029700 ** LINEARLY INTERPOLATE AND SCALE DESIRED SAMPLE 00029800 ** TX(I-IXM) = (FQ * T0(L+1) + (1.-FQ) * T0(L)) 00029900 SPACE 1 00030000 LOC200 DS 0H 00030100 L R1,CV2 MULT L BY 4 TO ADDRESS T0 00030200 BCTR R1,0 00030300 SLL R1,2 00030400 LE FR2,4(R1,R2) LOAD T0(L+1) 00030500 ME FR2,FQ COMPUTE T0(L+1) * FQ 00030600 LE FR4,FK1 00030700 SE FR4,FQ COMPUTE 1.-FQ 00030800 ME FR4,0(R1,R2) COMPUTE (1.-FQ) * TO(L) 00030900 AER FR2,FR4 ADD BOTH COMPUTATIONS 00031000 L R1,NDX COMPUTE ADDRESS IN TX 00031100 SLL R1,2 00031200 BCTR R9,0 RESET NDX FOR NEXT TIME 00031300 ST R9,NDX THRU LOOP 00031400 STE FR2,0(R1,R11) SAVE IN TX(I-IXM) 00031500 SE FR6,FK1 RESET MFLT (FR6) FOR ANOTHER LOOP 00031600 L R5,J RELOAD VALUE OF J (INTEGER) 00031700 BCT R7,LOOP THIS ROUTINE MAKES A CONSTANT 00031800 * EXTRAPOLATION WHEN REQUIRED POINTS 00031900 * IN TX MAP OUTSIDE THE RANGE OF PTS. 00032000 * AVAILABLE FROM T0 00032100 L R13,4(0,R13) RESTORE R13 00032200 L R14,12(0,R13) DONT RESTORE R15 00032300 MVI 12(R13),255 00032400 LM R2,R12,28(R13) RESTORE REGISTERS 00032500 BR R14 RETURN TO CALLER 00032600 EJECT 00032700 *********************************************************************** 00032800 * * 00032900 * CONSTANTS AND WORKING STORAGE * 00033000 * * 00033100 *********************************************************************** 00033200 SPACE 2 00033300 ADCONS DS 0F 00033400 ADDRT0 DS F ADDR OF T0 - INPUT 00033500 ADDRV DS F ADDR OF V - INPUT 00033600 ADDRI0 DS F ADDR OF I0 - INPUT 00033700 ADDRN0 DS F ADDR OF N0 - INPUT 00033800 ADDRIX DS F ADDR OF IX - INPUT 00033900 ADDRNX DS F ADDR OF NX - INPUT 00034000 ADDRX DS F ADDR OF X - INPUT 00034100 ADDRKEY DS F ADDR OF KEY - INPUT 00034200 ADDRSR DS F ADDR OF SR - INPUT 00034300 ADDRTX DS F ADDR OF TX - OUTPUT 00034400 * 00034500 FK0 DC E'0.0' FLT CONSTANT 0. 00034600 FK1 DC E'+1.0' FLT CONSTANT 1. 00034700 FK1T DC E'+0.1' FLT CONSTANT .1 00034800 FK5T DC E'+0.5' FLT CONSTANT .5 00034900 KEY DC F'0' ASSUMMED VALUE FOR KEY (INPUT) 00035000 P DC E'+1.0' SST SCALE (REMAINS CONSTANT W/KEY=0) 00035100 DDT DC E'+0.1' MAX TIME ERROR (.1 OF SAMPLE) 00035200 K DS F INTEGER VALUE K 00035300 KFLT DS F FLT. PT. VALUE K 00035400 FJ DS F CALCULATED VALUE 00035500 H DS F CALCULATED VALUE 00035600 HDFJ DS F CALCULATED VALUE H/FJ 00035700 J DS F CALCULATED VALUE (INTEGER) 00035800 JFLT DS F FLT PT CALCULATED VALUE J 00035900 FACTOR DS F CALCULATED VALUE 00036000 I0M DS F CALCULATED VALUE (INTEGER = I0-1) 00036100 I0MFLT DS F CALCULATED VALUE (FLT.PT) 00036200 IXM DS F CALCULATED VALUE (INTEGER = IX-1) 00036300 QJ DS F CALCULATED VALUE 00036400 FQ DS F CALCULATED VALUE 00036500 MM DS F CALCULATED VALUE 00036600 MFLT DS F CALCULATED VALUE M (FLT.PT) USED IN 00036700 * LOOP CALCULATIONS * = I (FLT.PT.) 00036800 I DS F CALCULATED VALUE 00036900 FJL DS F CALCULATED VALUE (LOWER BRACKET) 00037000 FJH DS F CALCULATED VALUE (UPPER BRACKET) 00037100 NDX DS F INDEX FOR SAVING INTO TX 00037200 * 00037300 ** CONSTANTS AND WORKING LOCS FOR FLT.PT/INTEGER CONVERSIONS 00037400 * 00037500 DS 0D INSURE DOUBLE WORD BOUNDARY 00037600 CV1 DC XL4'4E000000' 00037700 CV2 DC XL4'00000000' 00037800 CV3 DC XL4'4F080000' 00037900 CV4 DC XL4'00000000' 00038000 CV5 DC XL4'00000000' 00038100 CV6 DC XL4'00000000' 00038200 * 00038300 LTORG 00038400 END 00038500