CTITLESAOMN -- PERFORMS REVERSE NORMAL MOVEOUT (FORTRAN) 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR DAVID THOMPSON, J. MENDEKE 00000020 CA DESIGNER DAVID THOMPSON 00000030 CA LANGUAGE S/370 FORTRAN H 00000040 CA WRITTEN 11-22-78 00000050 CA 00000060 CA 00000070 CA CALL SAOMN (T0, V, I0, N0, IX, NX, X, KEY, SR, TX) 00000090 CA INPUT T0 = ZERO OFFSET TRACE R4 00000100 CA INPUT V = VELOCITY ARRAY (UNIT DIST/ SEC.) R4 00000110 CA INPUT I0 = SAMPLE NO. (TIME ZERO) FOR T0(1) I4 00000120 CA INPUT N0 = NO. OF SAMPLES IN T0 AND V I4 00000130 CA INPUT IX = SAMPLE NO. (TIME ZER0) FOR TX(1) I4 00000140 CA INPUT NX = NO. OF SAMPLES IN TX I4 00000150 CA INPUT X = OFFSET DISTANCE R4 00000160 CA INPUT KEY = COMPRESSION RATIO SCALING I4 00000170 CA 0 = NO SCALING 00000180 CA 1 = BY DELTAT(0 OFFSET)/DELTAT(X OFFSET) 00000190 CA -1 = BY RECIPROCAL 00000200 CA INPUT SR = SAMPLE INTERVAL (SEC.) R4 00000210 CA OUTPUT TX = OUTPUT TRACE R4 00000220 CA 00000230 CA THIS SUBROUTINE PERFORMS REVERSE NORMAL MOVEOUT. 00000240 CA 00000250 C 00000260 SUBROUTINE SAOMN (T0, V, I0, N0, IX, NX, X, KEY, SR, TX) 00000270 C 00000280 C REAL ARRAYS IN PARAMETER LIST 00000290 C 00000300 REAL T0(1) 00000310 REAL V (1) 00000320 REAL TX(1) 00000330 C SET INDECIES AND SST SCALE P = 1.0 00000340 P=1. 00000350 I0M=I0-1 00000360 IXM=IX-1 00000370 M=NX+IX 00000380 MM=N0-1 00000390 C MAX TIME ERROR (.1 OF SAMPLE) 00000400 DDT = .1 00000410 C COMPUTATION OF OFFSET EQUIV. OF FINAL TIME IN T0 00000420 FJ=X/(V(N0)*SR) 00000430 K=N0+I0M 00000440 C NEWTON RHAPSON SQRT ESTIMATION 00000450 IF(FJ.LT.K) FJ=K 00000460 H=X/(V(N0)*SR) 00000470 H=K*K+H*H 00000480 HDFJ=H/FJ 00000490 C LOOP BACK TO HERE IF MORE ITERATIONS NEEDED FOR SQRT 00000500 10 FJ=.5*(FJ+HDFJ) 00000510 HDFJ=H/FJ 00000520 C TEST FOR MORE INTERATIONS ON SQRT 00000530 IF(ABS(FJ-HDFJ)-DDT) 20 , 20 , 10 00000540 C SET FJH=FJL= COMPUTED FINAL TIME. 00000550 C INITIATE J AT BOTTOM OF T0 00000560 20 J=N0 00000570 FJH=FJ 00000580 FJL=FJ 00000590 C FOR SCALING COMPUTE OFFSET EQUIV. 00000600 C OF NEXT TO LAST POINT IN T0 00000610 IF(KEY.EQ.0) GO TO 50 00000620 H=X/(V(N0-1)*SR) 00000630 KM=K-1 00000640 H=KM*KM+H*H 00000650 HDFJ=H/FJ 00000660 C LOOP HERE IF MORE ITERATIONS NEEDED FOR SQRT 00000670 30 FJ=.5*(FJ+HDFJ) 00000680 HDFJ=H/FJ 00000690 C TEST IF MORE ITERATIONS NEEDED FOR SQRT 00000700 IF(ABS(FJ-HDFJ)-DDT) 40 , 40 , 30 00000710 C COMPUTE DEHAT(0 OFFSSET)/DELTAT(X OFFSET) 00000720 C FOR LAST SAMPLE 00000730 40 P=1./(FJH-FJ) 00000740 C RECIPROCATE IF NECESSARY 00000750 IF(KEY.LT.0) P=1./P 00000760 C MAIN LOOP - WORK FROM BOTTOM TO TOP OF TX 00000770 50 DO 200 00000780 * II=1,NX 00000790 I=M-II 00000800 C IS CURRENT SAMPLE < OR >= TO UPPER BRACKET FJH 00000810 C 00000820 IF(I-FJH) 60 , 140 , 140 00000830 C IS CURRENT SAMPLE < OR >= TO LOWER BRACKET FJL 00000840 60 IF(I-FJL) 70 , 130 , 130 00000850 C SET NEW UPPER BRACKET TO OLD LOWER BRACKET 00000860 70 FJH=FJL 00000870 C TRY NEW J - ARE WE AT THE TOP OF T0 00000880 80 IF(J-1) 140 , 140 , 90 00000890 C DECREMENT J AND COMPUTE ITS OFFSET EQUIV. 00000900 90 J=J-1 00000910 K=J+I0M 00000920 H=X/(V(J)*SR) 00000930 H=K*K+H*H 00000940 HDFJ=H/FJ 00000950 C SQRT CALCULATION OF OFFST EQUIV. 00000960 100 FJ=.5*(FJ+HDFJ) 00000970 HDFJ=H/FJ 00000980 C TEST SUFFICIENT ACCURACY OF SQRT 00000990 IF(ABS(FJ-HDFJ)-DDT) 110 , 110 , 100 00001000 C FJ IS OFFST EQUIV. OF J. TEST IF OFFSET 00001010 C POINTER BELOW OR ABOVE FJ. 00001020 110 IF(I-FJ) 120 , 130 , 130 00001030 C BELOW FJ. RESET UPER BRACKET TO FJ - TRY SMALLER J 00001040 C 00001050 120 FJH=FJ 00001060 GO TO 80 00001070 C DESIRED POINT IS BRACKETED. COMPUTE COMPRESSION 00001080 C RATIO AND SCALE P 00001090 130 FJL=FJ 00001100 FACTOR=1./(FJH-FJL) 00001110 C CHANGE P FROM 1.0 TO DELTAT RATIO 00001120 IF(KEY.NE.0) P=FACTOR 00001130 C RECIPROCATE SCALE IF REQUIRED. 00001140 C COMPUTE FRACTIONAL SAMPLE WANTED IN T0. 00001150 IF(KEY.LT.0) P=1./P 00001160 QJ=J-(FJH-I)*FACTOR+1. 00001170 GO TO 150 00001180 C SPECIAL CALCULATION FOR DESIRED SAMPLE 00001190 C WHEN AT TOP OF T0 00001200 140 QJ=I *(J+I0M)/FJL-I0M 00001210 C COMPUTE NEXT LOWER INTEGER TO DESIRED SAMPLE 00001220 150 L=QJ 00001230 C IS NEXT LOWER INTEGER BELOW 1 00001240 IF(L) 160 , 160 , 170 00001250 C YES - SET TO 1 00001260 160 L=1 00001270 C INTEGER IS >= 1. IS INTEGER >=LAST ELEMENT OF T0? 00001280 170 IF(L-MM) 190 , 190 , 180 00001290 C INTEGER AT OR BEYOND END OF T0. SET TO NEXT TO LAST 00001300 180 L=MM 00001310 C 00001320 190 FQ=QJ-L 00001330 C LINEARLY INTERPOLATE AND SCALE DESIRED SAMPLE 00001340 200 TX(I-IXM)=(FQ*T0(L+1)+(1.-FQ)*T0(L))*P 00001350 C END OF MAIN LOOP 00001360 C 00001370 C THIS ROUTINE MAKES A CONSTANT EXTRAPOLATION WHEN REQUIRED 00001380 C POINTS IN TX MAP OUTSIDE THE RANGE OF POINTS AVAILABLE FROM T0 00001390 RETURN 00001400 END 00001410