CTITLEMSLOG -- CONVERSION TO SEISMIC LOGS 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D. D. THOMPSON 00000020 CA DESIGNER D. D. THOMPSON 00000030 CA LANGUAGE S/370 FORTRAN H EXTENDED 00000040 CA WRITTEN 10-01-76 00000050 C REVISED 04-27-78 R MCMILLAN. PUT IN CHECK FOR 00000060 C DIVISON BY 0 IN DO LOOP AT 120. 00000070 C REVISED 08-01-80 D. POLAK - ADDED OPTION FOR SHARP INTERFACE 00000080 C SEISMIC LOGS. 00000090 C 00000100 CA 00000110 CA 00000120 CA CALL MSLOG (R,NA,NB,VAITT,SL,KS,SCALE,NBLEND,X,IFLG) 00000130 CA INPUT R = DECONVOLVED TRACE ARRAY. R4 00000140 CA INPUT NA = FIRST SAMPLE IN R TO USE. I4 00000150 CA INPUT NB = LAST SAMPLE IN R TO USE. I4 00000160 CA INPUT VAITT = ARRAY OF INTERVAL TRANSIT TIMES R4 00000170 CA FOR EACH SAMPLE OF SL TO BE BLENDED. 00000180 CA OUTPUT SL = SEISMIC LOG ARRAY. R4 00000190 CA INPUT KS = RESAMPLE FLAG. I4 00000200 CA - 0 MEANS SL AND R HAVE THE SAME 00000210 CA SAMPLE PERIOD. 00000220 CA - 1 MEANS SL HAS HALF SAMPLE PERIOD 00000230 CA OF R. 00000240 CA (NOTE RANGE OF SAMPLES IN SL IS 00000250 CA (KS+1)*NA TO (KS+1)*NB ) 00000260 CA INPUT SCALE = MULTIPLIER TO APPLY TO R. R4 00000270 CA INPUT NBLEND= BLENDING PARAMETER. I4 00000280 CA IF NOT ZERO REMOVE |NBLEND| SAMPLE 00000290 CA SLIDING AVERAGE FROM R FIRST. 00000300 CA IF POSITIVE USE NBLEND SAMPLE BLEND 00000310 CA WINDOW. 00000320 CA IF NEG. OR ZERO FREE RUN FROM TOP 00000330 CA THIS PARAMETER REFERS TO SAMPLES AT 00000340 CA THE SAMPLE RATE OF SL. 00000350 CA IN/OUT X = SCRATCH ARRAY OF MIN LENGTH R4 00000360 CA (NB-NA)*(KS+1)+1. 00000370 CA INPUT IFLG = FLAG FOR SHARP INTERFACE OPTION I4 00000380 CA - 0 MEANS GENERATE NORMAL LOGS 00000390 CA - 1 MEANS GENERATE LOGS WITH SHARP INTERFACES00000400 CA 00000410 CA 00000420 CA 00000430 CA THIS ROUTINE COMPUTES A SEISMIC LOG FROM A DECONVOLVED 00000440 CA TRACE BLENDED WITH A LOW FREQUENCY VELOCITY PROFILE. 00000450 C 00000460 C SUBROUTINES CALLED: 00000470 C 00000480 C MVAV 00000490 C S1ATP - ARMVE 00000500 C 00000510 C EJECT 00000520 C====================================================================== 00000530 C 00000540 SUBROUTINE MSLOG (R, NA, NB, VAITT, SL, KS, SCALE, NBLEND, 00000550 * X, IFLG) 00000560 C 00000570 C 00000580 REAL*4 R(1),VAITT(1),SL(1),X(1) 00000590 REAL*8 S 00000600 EXTERNAL S1ATP 00000610 NAS=NA 00000620 IF(KS.NE.0) NAS=2*NA 00000630 NR=NB-NA+1 00000640 NBST=NAS+NR-1 00000650 NBS=NBST 00000660 C 00000670 C IF REQUIRED HIGH PASS FILTER R INTO SL 00000680 C OTHERWISE MOVE R TO SL 00000690 C 00000700 IF(NBLEND.EQ.0) GO TO 10 00000710 KBLEND = IABS(NBLEND) 00000720 IF(KS.NE.0) KBLEND = KBLEND/2 00000730 CALL MVAV(R(NA),NR,-KBLEND,SL(NAS)) 00000740 GO TO 15 00000750 C 00000760 10 CALL ARMVE(R(NA),SL(NAS),NR) 00000770 C 00000780 C SHARP INTERFACE OPTION - BRANCH FOR NORMAL LOGS 00000790 C 00000800 15 IF (IFLG .EQ. 0) GO TO 28 00000810 PEAK2 = 0. 00000820 VALSV = 0. 00000830 C 00000840 C MODIFY RC'S SO ALL ENERGY IS CONCENTRATED 00000850 C ONLY AT LOCAL PEAKS 00000860 C 00000870 KK = NAS 00000880 KFLAG = 0 00000890 DO 25 00000900 * II = 1, NR 00000910 JJ = II + NAS - 1 00000920 VAL = SL(JJ) 00000930 VAL2 = VAL * VAL 00000940 IF (VAL2 .GE. PEAK2 .OR. ABS(VAL) .GE. VALSV .OR. 00000950 * VAL*SL(KK) .LT. 0.) GO TO 20 00000960 SL(KK) = SL(KK) + VAL 00000970 VALSV = ABS(VAL) 00000980 SL(JJ) = 0. 00000990 KFLAG = 0 00001000 GO TO 25 00001010 20 KK = JJ 00001020 PEAK2 = SL(KK)**2 00001030 VALSV = ABS(SL(KK)) 00001040 IF (KFLAG. EQ. 0) GO TO 24 00001050 SL(KK) = SL(KK) + SL(KK - 1) 00001060 SL(KK - 1) = 0. 00001070 GO TO 25 00001080 24 KFLAG = 1 00001090 C 00001100 25 CONTINUE 00001110 C 00001120 C CONVERT SL TO UNBLENDED FREE-RUN 00001130 C LOG IN PLACE 00001140 C 00001150 28 S=VAITT(NAS) 00001160 IF(NBLEND.GT.0) S = 1. 00001170 C 00001180 DO 30 00001190 * I=NAS,NBST 00001200 P=SCALE*SL(I) 00001210 Q=ABS(P) 00001220 IF(Q.GT..9) Q=.9 00001230 IF(P.LT.0.) Q=-Q 00001240 S=S*(1.-Q)/(1.+Q) 00001250 C 00001260 30 SL(I)=S 00001270 C 00001280 C CHECK TO SEE IF RESAMPLING IS NEEDED 00001290 C IF SO RESAMPLE SL IN PLACE USING CUBIC 00001300 C INTERPOLATION (LINEAR ON ENDS). 00001310 C 00001320 IF(KS.EQ.0) GO TO 60 00001330 C 00001340 NBS=2*NB 00001350 NBSM=NBS-2 00001360 NASP=NAS+2 00001370 NSUM=NBS+NAS 00001380 SL(NBS)=SL(NBST) 00001390 SL(NBS-1) = .5 * (SL(NBST-1) + SL(NBST)) 00001400 C 00001410 DO 50 00001420 * II=NASP,NBSM 00001430 I=NSUM-II 00001440 L=I/2 00001450 IF(L*2.EQ.I) GO TO 40 00001460 L = L + NA 00001470 SL(I) = .5625 * (SL(L)+SL(L+1))- .0625 * (SL(L-1)+SL 00001480 * (L+2)) 00001490 GO TO 50 00001500 C 00001510 40 SL(I)=SL(L+NA) 00001520 C 00001530 50 CONTINUE 00001540 C 00001550 SL(NAS+1) = .5 * (SL(NAS)+SL(NAS+1)) 00001560 C 00001570 C END RESAMPLING 00001580 C 00001590 60 IF(NBLEND.LE.0) RETURN 00001600 C 00001610 C BLEND SL WITH VAITT AND PUT IN SL. 00001620 C PERFORM SLIDING WINDOW GEOMETRIC AVERAGING 00001630 C OF SL INTO X. 00001640 C 00001650 NR=NBS-NAS+1 00001660 NW=IABS(NBLEND) 00001670 K=(NW-1)/2 00001680 NASM = NAS - 1 00001690 IF(K.NE.0) GO TO 70 00001700 CALL ARMVE(SL(NAS),X,NR) 00001710 GO TO 110 00001720 C 00001730 70 NV=2*K+1 00001740 S=SL(NAS) 00001750 KP=K+1 00001760 X(1)=S 00001770 J=2+NASM 00001780 C 00001790 DO 100 00001800 * I=2,NR 00001810 IF(I.GT.KP) GO TO 80 00001820 S=S*SL(J)*SL(J+1) 00001830 J=J+2 00001840 X(I)=S**(1./(2*I-1)) 00001850 GO TO 100 00001860 C 00001870 80 IF(I.GT.NR-K) GO TO 90 00001880 J=I-K-1+NASM 00001890 S=S*SL(I+K+NASM)/SL(J) 00001900 X(I)=S**(1./NV) 00001910 GO TO 100 00001920 C 00001930 90 S=S/(SL(J+1)*SL(J+2)) 00001940 J=J+2 00001950 X(I)=S**(1./(2*(NR-I)+1)) 00001960 C 00001970 C BLEND SL GEOMETRICALLY BY REPLACING 00001980 C GEOMETRIC AVERAGES IN X WITH VAITT VALUES. 00001990 C 00002000 100 CONTINUE 00002010 C 00002020 110 DO 120 00002030 * I=NAS,NBS 00002040 IF (X(I-NASM) .NE. 0.) GO TO 115 00002050 IF (I .EQ. NAS) SL(I) = VAITT(I) 00002060 IF (I .NE. NAS) SL(I) = SL(I-1) 00002070 GO TO 120 00002080 C 00002090 115 SL(I)=SL(I)*VAITT(I)/X(I-NASM) 00002100 C 00002110 120 CONTINUE 00002120 C 00002130 RETURN 00002140 END 00002150