CAINDMSAVS21 -- CALCULATE ANALYSIS START TIME FOR VSPA 00000020 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLE SAVS21 -- CALCULATE ANALYSIS START TIME FOR VSPA 00000020 CA AUTHOR P. D. HUDDLESTON AOGC R&D 00000030 CA DESIGNER P. D. HUDDLESTON 00000040 CA LANGUAGE FORTRAN H 00000050 CA SYSTEM S/370 00000060 CA WRITTEN AUG/1981 00000070 C REVISED MAY 82 -- REWRITTEN FOR SPARC BY RDK 00000080 CA 00000090 CA CALL SAVS21 ( TRACE, NPTS, IST ) 00000100 CA 00000110 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00000120 CA 00000130 CA IN TRACE R4 ARRAY CONTAINING TRACE TO ANALYZE 00000140 CA IN NPTS I4 TRACE LENGTH IN SAMPLES 00000150 CA OUT IST I4 TRACE INDEX OF CALCULATED TIME 00000160 CA 00000170 CA CALCULATES START TIME FOR ANALYSIS ON THE TRACE FOR VSPA. 00000180 CAEND C EJECT 00000190 C ===================================================================== 00000200 CTITLE SAVS22 -- INTERPOLATES TIMES/VELOCITIES BETWEEN VSP DEPTHS 00000210 CA AUTHOR R. D. KNIGHT AOGC GDP 00000220 CA DESIGNER R. D. KNIGHT 00000230 CA LANGUAGE FORTRAN H 00000240 CA SYSTEM S/370 00000250 CA WRITTEN MAY/1982 00000260 C REVISED 00000270 CA 00000280 CA CALL SAVS22 ( CNRML, TRVTM, DEPTH, TVDTM, THETA, DELTA, 00000290 CA * AUTCR, CRSCR, INTVL, RANGE, TVDDL, NDX2 ) 00000300 CA 00000310 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00000320 CA 00000330 CA IN/OUT CNRML R4 QUALITY CONTROL ARRAY 00000340 CA IN/OUT TRVTM R4 CALCULATED TRAVEL TIMES 00000350 CA IN DEPTH R4 STATION DEPTHS 00000360 CA IN/OUT TVDTM R4 VERTICAL TRAVEL TIMES 00000370 CA IN THETA R4 ARRIVAL ANGLES 00000380 CA IN/OUT DELTA R4 TRAVEL TIME DIFFERENCES 00000390 CA IN/OUT AUTCR R4 AUTOCORRELATION ARRAY 00000400 CA IN/OUT CRSCR R4 CROSSCORRELATION ARRAY 00000410 CA IN/OUT INTVL R4 INTERVAL VELOCITY ARRAY 00000420 CA IN RANGE R4 RECEIVER-SOURCE RANGE ARRAY 00000430 CA IN/OUT TVDDL R4 VERTICAL TRAVELTIME DIFFERENCES 00000440 CA IN NDX2 I4 LENGTH OF INPUT ARRAYS 00000450 CA 00000460 CA THIS ROUTINE INTERPOLATES TRAVELTIME/VELOCITIES BETWEEN 00000470 CA VSP DEPTHS AT WHICH STANDARD ANALYSIS HAS FAILED. 00000480 CA 00000490 CAEND C EJECT 00000500 C 00000510 C ===================================================================== 00000520 C 00000530 SUBROUTINE SAVS21 ( TRACE, NPTS, IST ) 00000540 C 00000550 C ===================================================================== 00000560 C 00000570 C REAL ARRAYS IN PARAMETER LIST 00000580 C 00000590 DIMENSION TRACE ( 1) 00000600 C 00000610 DIMENSION AUTCR ( 1) 00000620 DIMENSION CNRML ( 1) 00000630 DIMENSION CRSCR ( 1) 00000640 DIMENSION DELTA ( 1) 00000650 DIMENSION DEPTH ( 1) 00000660 DIMENSION INTVL ( 1) 00000670 DIMENSION RANGE ( 1) 00000680 DIMENSION THETA ( 1) 00000690 DIMENSION TRVTM ( 1) 00000700 DIMENSION TVDDL ( 1) 00000710 DIMENSION TVDTM ( 1) 00000720 C 00000730 REAL INTVL 00000740 REAL*8 SUM 00000750 C 00000760 ALPHA=4.0 00000770 C 00000780 C SCAN THE TRACE AND COMPUTE THE RMS LEVEL 00000790 C 00000800 SUM = TRACE(1)*TRACE(1) 00000810 C 00000820 DO 10 I=2,NPTS 00000830 10 SUM=SUM+(TRACE(I)*TRACE(I)) 00000840 SUM=SUM/NPTS 00000850 RMS=DSQRT(SUM) 00000860 C 00000870 C SCAN THE TRACE AND FIND THE FIRST EVENT WITH MAGNITUDE LARGER 00000880 C THAN ALPHA*RMS AND WITH NEGATIVE POLARITY 00000890 00000900 RMS=ALPHA*RMS 00000910 C 00000920 DO 20 I=1,NPTS 00000930 SAMPLE=TRACE(I) 00000940 IF ( SAMPLE.GT.0.0) GO TO 20 00000950 SAMPLE=ABS(SAMPLE) 00000960 IF (SAMPLE.LE.RMS) GO TO 20 00000970 GO TO 30 00000980 20 CONTINUE 00000990 C 00001000 C NO EVENT FOUND, RETURN 0 00001010 C 00001020 IST = 0 00001030 RETURN 00001040 C 00001050 C EVENT DETECTED AT SAMPLE I 00001060 C 00001070 30 IST = I 00001080 RETURN 00001090 C 00001100 C ==================================================================== 00001110 ENTRY SAVS22( CNRML, TRVTM, DEPTH, TVDTM, THETA, DELTA, 00001120 * AUTCR, CRSCR, INTVL, RANGE, TVDDL, NDX2 ) 00001130 C ==================================================================== 00001140 C 00001150 INDX = NDX2 - 1 00001160 INP1 = 1 00001170 INP2 = 3 00001180 C 00001190 DO 800 I = 2, INDX 00001200 IF (CNRML(I) .GT. 0.0) GO TO 780 00001210 C 00001220 760 IF (CNRML(INP2).GT.0.0 .OR. INP2.EQ.NDX2) GO TO 770 00001230 INP2 = INP2 + 1 00001240 GO TO 760 00001250 C 00001260 770 TRVTM(I) = 00001270 *TRVTM(INP1) + 00001280 *((TRVTM(INP2)-TRVTM(INP1))/ 00001290 * (RANGE(INP2)-RANGE(INP1))) * 00001300 * (RANGE( I)-RANGE(INP1)) 00001310 TVDTM(I) = TRVTM(I) * COS(THETA(I)) 00001320 DELTA(I) = TRVTM(INP1)-TRVTM(I) 00001330 IF(CNRML(I).NE.-999.) GO TO 775 00001340 AUTCR(I) = 0.0 00001350 CRSCR(I) = 0.0 00001360 775 CNRML(I) = -CNRML(INP2) 00001370 INTVL(I) = (RANGE(INP1)-RANGE(I))/ 00001380 * DELTA(I )*1000. 00001390 TVDDL(I) = (DEPTH(I)-DEPTH(INP1))/ 00001400 * INTVL(I )*1000. 00001410 C 00001420 DELTA(INP2) = TRVTM(I)-TRVTM(INP2) 00001430 INTVL(INP2) = (RANGE(I)-RANGE(INP2))/ 00001440 * DELTA(INP2)*1000. 00001450 TVDDL(INP2) = (DEPTH(INP2)-DEPTH(I))/ 00001460 * INTVL(INP2)*1000. 00001470 C 00001480 C GO TO 790 00001490 C 00001500 780 INP1 = I 00001510 790 INP2 = MAX0(INP2,I+2) 00001520 C 00001530 800 CONTINUE 00001540 C 00001550 RETURN 00001560 C 00001570 END 00001580