CTITLESASTW -- COMPUTE STARTING WAVELET 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D. D. THOMPSON 00000020 CA DESIGNER D. D. THOMPSON 00000030 CA LANGUAGE FORTRAN 77 00000040 CA SYSTEM IBM & CRAY 00000041 CA WRITTEN 10-09-76 00000050 C REVISED 03-23-78 REM. CHANGE MNORM TO ARMPFC. 00000060 C REVISED 10-02-84 REP. COMPILED WITH VSFORTRAN. 00000061 C REVISED 04-19-85 TWH. CHANGE SOURCE TO AGREE 00000062 C WITH 3/23/78 REV. POSSIBLY SOURCE & 00000063 C OBJECT DID NOT AGREE. AFTER VSFORTRAN 00000064 C CONVERSION MNORM WAS UNRESOLVED, CAUS- 00000065 C ING AN OC4 ABORT. 00000066 C REVISED 05-20-85 TWH. ADAPTED TO RUN ON IBM & 00000067 C CRAY SYSTEMS. 00000068 C 00000070 CA 00000080 CA 00000090 CA CALL SASTW (X,ILO,IHI,W,KW,KWMAX,LGGS,FL,FH1,FH2,IPRNT, 00000100 CA IPR,IER,S) 00000110 CA 00000120 CA INPUT X = INPUT TRACE R4 00000130 CA INPUT ILO = AUTOCORRELATION START SAMPLE I4 00000140 CA INPUT IHI = AUTOCORRELATION STOP SAMPLE I4 00000150 CA OUTPUT W = RETURNED WAVELET R4 00000160 CA OUTPUT KW = RETURNED ACTUAL WAVELET LENGTH IN I4 00000170 CA SAMPLES 00000180 CA INPUT KWMAX = MAX WAVELET LENGTH I4 00000190 CA >0 - MIN PHASE WAVELET 00000200 CA <0 - MAX ENTROPY WAVELET MIN PHASE 00000210 CA INPUT LGGS = NUMBER OF SAMPLES LAG FOR I4 00000220 CA AUTOCORRELATION 00000230 CA >0 - MIN PHASE WAVELET 00000240 CA <0 - LINEAR PHASE WAVELET 00000250 CA INPUT FL = LOW CUT FILTER IN HERTZ R4 00000260 CA INPUT FH1 = HIGH PASS FILTER IN HERTZ R4 00000270 CA INPUT FH2 = HIGH CUT FILTER IN HERTZ R4 00000280 CA INPUT IPRNT = PRINT CODES I4 00000290 CA INPUT IPR = PRINT UNIT NUMBER I4 00000300 CA OUTPUT IER = ERROR RETURN CODE I4 00000310 CA 0 - OK 00000320 CA 1 - NULL TRACE (NO WAVELET) 00000330 CA INPUT S = SAMPLE PERIOD R4 00000340 CA 00000350 CA 00000360 CA THIS ROUTINE COMPUTES A STARTING WAVELET FOR 00000370 CA ITERATIVE DECONVOLUTION. 00000380 CA 00000390 CA 00000400 C 00000410 C SUBROUTINES CALLED: MFLTR 00000420 C MCROSS 00000430 C MCUT 00000440 C MNWAVE 00000450 C ARMPFC (S1ATP) 00000460 C SAPGPT 00000470 C MPEAK 00000480 C MAXENT 00000490 C 00000500 SUBROUTINE SASTW(X,ILO,IHI,W,KW,KWMAX,LGGS,FL,FH1,FH2,IPRNT, 00000510 * IPR,IER,S) 00000520 CAEND 00000530 C 00000540 DIMENSION W(1),X(1),AC(4),WV(2),TIME(3),IPRNT(2) 00000550 LAGS = IABS(LGGS) 00000560 IF(KWMAX.LT.0) GO TO 10 00000570 CALL MFLTR(FL,FH1,FH2,S ) 00000580 C 00000590 10 N=IHI-ILO+1 00000600 IF(KWMAX.LT.0 .AND. IPRNT(2).EQ.0) GO TO 20 00000610 CALL MCROSS(N,X(ILO),N,X(ILO),LAGS,W) 00000620 IER = 1 00000630 IF(W(1).EQ.0.0) RETURN 00000640 IF(IPRNT(1).NE.0) CALL SAPGPT(W,LAGS,0,0,0,IPR) 00000650 IER = 0 00000660 CCCC CALL MNORM (W,LAGS,1./W(1)) 00000665 CALL ARMPFC (W, W, 1./W(1), LAGS) 00000670 IF(IPRNT(2).EQ.0) GO TO 20 00000680 WRITE(IPR, 9000 )(W(I),I=1,LAGS) 00000690 C 00000700 20 IF(KWMAX.GE.0) GO TO 30 00000710 KW = -KWMAX 00000720 CALL MAXENT(X(ILO),N,W,KW) 00000730 GO TO 60 00000740 C 00000750 30 CALL MNWAVE(W,LGGS) 00000761 KMMAX = KWMAX 00000770 IF(LGGS.LT.0)KMMAX=(KMMAX+1)/2 00000780 CALL MCUT (W,KMMAX,KW,5.) 00000790 IF(LGGS.GT.0) GO TO 60 00000800 C 00000810 DO 40 00000820 * I=1,KW 00000830 II=KW+1-I 00000840 III=II+KW-1 00000850 C 00000860 40 W(III)=W(II) 00000870 C 00000880 DO 50 00000890 * I=2,KW 00000900 II=KW+I-1 00000910 III=KW-I+1 00000920 C 00000930 50 W(III)=W(II) 00000940 C 00000950 KW=2*KW-1 00000960 C 00000970 60 CONTINUE 00000980 CALL MPEAK(W,KW,VAL,PNT) 00000990 CCCC CALL MNORM(W,KW,1./ABS(VAL)) 00000995 CALL ARMPFC (W, W, 1./ABS(VAL), KW) 00001000 IF(IPRNT(2).EQ.0) RETURN 00001010 IF(LGGS.LT.0) GO TO 70 00001020 WRITE(IPR, 9010 )KW,( W(I),I=1,LAGS) 00001030 RETURN 00001040 C 00001050 70 WRITE(IPR, 9020 ) KW,(W(I),I=1,LAGS) 00001060 RETURN 00001070 C 00001080 9000 FORMAT('1...AUTOCORRELATION'/'0'/(' ',10F13.6)) 00001090 C 00001100 9010 FORMAT('0'/'0'/'0MIN. PHASE WAVELET--CUT AFTER',I5,' SAMPLES'/ 00001110 * '0'/(' ',10F13.6)) 00001120 C 00001130 9020 FORMAT('0'/'0'/'0ZERO PHASE WAVELET--CUT AFTER',I5, 00001140 *' SAMPLES'/'0'/(' ',10F13.6)) 00001150 C 00001151 END 00001160