CTITLESACRDP -- CONVERT RMS VELOCITY TO DEPTH 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR W. J. BROWN 00000020 CA DESIGNER W. J. BROWN 00000030 CA LANGUAGE FORTRAN 00000040 CA SYSTEM IBM AND CRAY 00000040 CA WRITTEN 04-01-76 00000050 C REVISED 01-19-77 BY WJB TO CHECK FOR NUMBER 00000060 C REVISED OF SAMPLES. 00000070 C REVISED 10-04-88 BY TJT TO RUN ON CRAY ALSO. 00000060 C REVISED 11-13-89 BY RDK MAKE CFT77 COMPATIBLE. 00000060 C REVISED MO-DA-YR 00000080 C 00000090 CA 00000100 CA 00000110 CA CALL SACRDP (VEL,NPTS,CTIME,CVEL,RLENG,SAMPR,IPR,VSI,PTS,ERROR)00000120 CA INPUT VEL = TIME-VELOCITY PAIRS, TIME I4 00000130 CA TIME(MS), RMS VEL. (FT/SEC) VEL. R4 00000140 CA INPUT NPTS = NUMBER OF POINTS IN VEL I4 00000150 CA INPUT IPR = INTERNAL PRINTER UNIT I4 00000160 CA INPUT CTIME = CORRECTIONAL TIME USED (MS) I4 00000170 CA INPUT CVEL = CORRECTIONAL VELOCITY USED I4 00000180 CA INPUT RLENG = RECORD LENGTH (MS) I4 00000190 CA INPUT SAMPR = SAMPLE RATE (MS) I4 00000200 CA OUTPUT VSI = DEPTHS SPACED AT THE SAMPLE INTERVAL I4 00000210 CA OUTPUT PTS = NUMBER OF POINTS IN VSI I4 00000220 CA OUTPUT ERROR = RETURNED ERROR FLAG I4 00000230 CA 00000240 CA 00000250 CA THE FUNCTION OF 'SACRDP' IS TO ADD OR DELETE 00000260 CA A LAYER FROM THE INPUT DATA 'VEL', AND CONVERT THE 00000270 CA TIME-RMS VELOCITY PAIRS TO TIME-DEPTH PAIRS FOR 00000280 CA EACH SAMPLE. 00000290 CA THE INPUT DATA IS WRITTEN BY THE ROUTINE 'SPVELF' 00000300 CA IN TIME-RMS PAIRS, AND PASSED IN THE ARRAY VEL. THE 00000310 CA OUTPUT IS RETURNED IN THE ARRAY VSI. 00000320 CA 00000330 CA 00000340 C 00000350 C SUBROUTINES CALLED: FORCA (FOIP) 00000360 C FORP (FIOP) 00000370 C FOWP (FIOP) 00000380 C ARMVE (S1ATP) 00000390 C USPHD 00000400 C USSLN 00000410 C S1CPCH 00000420 C S1CVBN 00000430 C S1MVCH 00000440 C USOVLP 00000450 C 00000460 C EJECT 00000470 C 00000480 C LOCAL OR INTERNAL ARRAYS. 00000490 C 00000500 C VEL ( 1) = ARRAY TO HOLD DEPTHS I4 00000510 C VSI ( 1) = ARRAY TO HOLD VELOCITIES I4 00000520 C T ( 250) = ARRAY FOR TIMES R4 00000530 C VA ( 250) = ARRAY FOR AVERAGE VELOCITIES R4 00000540 C VR ( 250) = ARRAY FOR RMS VELOCITIES R4 00000550 C VI ( 250) = ARRAY FOR INTEVERAL VELOCITIES R4 00000560 C 00000570 C LOCAL OR INTERNAL VARIABLES AND CONSTANTS. 00000580 C 00000590 C CTIME = CORRECTIONAL TIME I4 00000600 C CRVELU = CORRECTIONAL VELOCITY FOR THE ROUTINE I4 00000610 C CTRMU = CORRECTIONAL TIME I4 00000620 C CVEL = CORRECTIONAL VELOCITY PASSED IN PARAMENTER LIST I4 00000630 C DI = DEPTH FOR SAMPLE I R4 00000640 C DIP1 = DEPTH FOR SAMPLE I + 1 R4 00000650 C SUMD = SUM OF DEPTHS R4 00000660 C IPR = PRINTER UNIT I4 00000670 C IVP = NUMBER OF VELOCITY POINTS I4 00000680 C IVPM1 = NUMBER OF VELOCITY POINTS MINUS ONE I4 00000690 C KOUNT = INDEX IN THE PASSED VELOCITY ARRAY I4 00000700 C KNT = COUNTER FOR NUMBER OF TIMES AND VELOCITIES TO ADJUST I4 00000710 C KNT1 = INDEX IN THE ADJUSTED ARRAY FOR VELOCITY I4 00000720 C KNT2 = INDEX IN THE ADJUSTED ARRAY FOR TIME I4 00000730 C NPTS = NUMBER OF POINTS IN THE INPUT VELOCITY ARRAY I4 00000740 C NSAMP = NUMBER OF SAMPLES RLENG/SAMPR I4 00000750 C PTS = NUMBER OF POINTS IN THE COMPUTED DEPTH ARRAY I4 00000760 C RLENG = RECORD LENGTH I4 00000770 C SAMPR = SAMPLE RATE I4 00000780 C SUMVT = SUM VALUE FOR COMPUTING AVERAGE VELOCITIES I4 00000790 C TNEW = NEW TIME R4 00000800 C VDIF = VELOCITY DIFFERENCE R4 00000810 C VFOUR = VELOCITY AT FOUR MS R4 00000820 C VTWO = VELOCITY AT SECOND SAMPLE R4 00000830 C VNEW = NEW VELOCITY R4 00000840 C VINC = VELOCITY INCREMENT I4 00000850 C Z1 = DEPTH ONE R4 00000860 C Z2 = DEPTH TWO R4 00000870 C EJECT 00000880 C====================================================================== 00000890 C 00000900 SUBROUTINE SACRDP (VEL,NPTS,CTIME,CVEL,RLENG, 00000910 *SAMPR,IPR,VSI,PTS,ERROR) 00000920 IMPLICIT INTEGER (A-Z) 00000930 CAEND 00000940 C 00000950 C ARRAYS PASSED IN THE PARAMENTER LIST 00000960 C 00000970 INTEGER VEL (1) 00000980 INTEGER VSI (1) 00000990 C LOCAL ARRAYS 00001000 REAL T (250) 00001010 REAL VA (250) 00001020 REAL VR (250) 00001030 REAL VI (250) 00001040 C 00001050 C EXTERNAL S1ATP 00001060 C 00001070 C LOCAL VARIABLES - REAL 00001080 C 00001090 REAL VFOUR 00001100 REAL VTWO 00001110 REAL SUMVT 00001120 REAL TNEW 00001130 REAL VNEW 00001140 REAL VDIF 00001150 REAL DI 00001160 REAL DIP1 00001170 REAL SUMD 00001180 REAL VINT 00001190 REAL TT 00001200 REAL Z1 00001210 REAL Z2 00001220 C 00001090 DATA T /250 * 0.0/ DATA VA /250 * 0.0/ DATA VR /250 * 0.0/ DATA VI /250 * 0.0/ C 00001090 CRTMU = IABS(CTIME) 00001230 CRVELU = CVEL 00001240 NSAMP = RLENG / SAMPR 00001250 C IF (1.EQ.2) CALL S1ATP C 00001260 C FILL THE TIME ARRAY (T) AND RMS 00001270 C VELOCITY ARRAY (VR) WITH THE 00001280 C INPUT TIME-VELOCITY PAIRS IN 00001290 C THE ARRAY VEL. 00001300 C 00001310 IVP = NPTS/2 00001320 J = 0 00001330 C 00001340 DO 10 00001350 * I= 1 , NPTS , 2 00001360 J = J + 1 00001370 T(J) = VEL(I) 00001380 CALL ARMVE (VEL(I+1),VR(J),1) 00001390 C 00001400 10 CONTINUE 00001410 C 00001420 C CONVERT RMS TO AVERAGE VELOCITIES 00001430 C TO MAKE THE CORRECTIONS. 00001440 C 00001450 VA(1) = VR(1) 00001460 C 00001470 C COMPUTE THE INTERMEDIATE INTERVAL VELOCITIES. 00001480 C 00001490 IVPM1 = IVP - 1 00001500 C 00001510 DO 20 00001520 * I = 1,IVPM1 00001530 VI(I)=(VR(I+1)*VR(I+1)*T(I+1)- VR(I)*VR(I)*T(I))/(T(I+1)-T(I))00001540 IF(VI(I).LT.0.) VI(I) = 0.0 00001550 VI(I) = SQRT(VI(I)) 00001560 C 00001570 20 CONTINUE 00001580 C 00001590 C COMPUTE THE AVERAGE VELOCITIES. 00001600 C 00001610 SUMVT = 0. 00001620 C 00001630 DO 30 00001640 * I = 2,IVP 00001650 SUMVT = SUMVT + VI(I-1)*(T(I)-T(I-1)) 00001660 VA(I) = SUMVT/T(I) 00001670 C 00001680 30 CONTINUE 00001690 C 00001700 IF (CVEL .EQ. 0) GO TO 130 00001710 IF (CTIME.EQ. 0) GO TO 130 00001720 C 00001730 C ADJUST THE AVERAGE VELOCITIES BY A LAYER 00001740 C DEFINED FROM TIME ZERO TO 'CRTMU' HAVING 00001750 C A VELOCITY OF 'CRVELU'. 00001760 C 00001770 C INSERT OR DELETE THE CORRECTIONAL LAYER 00001780 C 00001790 40 KNT = 1 00001800 C 00001810 DO 50 00001820 * I = 2,IVP 00001830 IF (T(I).GT.CRTMU) GO TO 50 00001840 KNT = I 00001850 C 00001860 50 CONTINUE 00001870 C 00001880 KNT =KNT + 1 00001890 KNT2 = 3 00001900 IF (KNT.EQ.2)KNT2 = IVP + 1 00001910 C 00001920 DO 60 00001930 * I = KNT,IVP 00001940 IF (KNT.EQ.2)KNT1 = KNT2 - 1 00001950 IF (KNT.GT.2)KNT1 = I 00001960 VA(KNT2) = VA(KNT1) 00001970 T (KNT2) = T(KNT1) 00001980 IF (KNT.EQ.2) KNT2 = KNT2 -1 00001990 IF (KNT.GT.2) KNT2 = KNT2 + 1 00002000 C 00002010 60 CONTINUE 00002020 C 00002030 IVP = IVP - (KNT-3) 00002040 C 00002050 70 IF ( CTIME .GT. 0 ) GO TO 100 00002060 TNEW = T(KNT) - CRTMU 00002070 VNEW = (VA(KNT)*T(KNT) - CRTMU*CRVELU) / (T(KNT)-CRTMU) 00002080 IF ( TNEW.NE.4. ) GO TO 80 00002090 VA (1) = VNEW 00002100 GO TO 90 00002110 C 00002120 80 VDIF = VA(KNT) - CRVELU 00002130 VFOUR = (( 4.*VDIF ) / TNEW ) + CRVELU 00002140 VTWO = (VFOUR*(CRTMU+4.)-CRTMU*CRVELU) / 4. 00002150 VA(1) = VNEW - ((TNEW*(VNEW-VTWO)) / (TNEW-4.)) 00002160 C 00002170 90 VA(2) = VNEW 00002180 T( 2 ) = TNEW 00002190 T(1) = 0. 00002200 GO TO 110 00002210 C 00002220 100 VA (1) = CRVELU 00002230 VA (2) = CRVELU 00002240 T ( 2) = CRTMU 00002250 C 00002260 C NOW ADJUST THE FUNCTION 00002270 C 00002280 110 IVPM1 = IVP - 1 00002290 J = 2 00002300 C 00002310 DO 120 00002320 * I = 3,IVP 00002330 J = J + 1 00002340 IF ( CTIME.GT.0)VA(J) = (CRTMU*CRVELU+T(I)*VA(I))/ 00002350 * (CRTMU+T(I)) 00002360 IF (CTIME.LT.0)VA(J) = (T(I)*VA(I)-CRTMU*CRVELU)/ 00002370 * (T(I)-CRTMU) 00002380 IF( CTIME.NE.0) T(J) = T(I) + CTIME 00002390 IF(T(J).GT.T(J-1)) GO TO 120 00002400 J = J - 1 00002410 C 00002420 120 CONTINUE 00002430 C 00002440 IVP = J 00002450 C 00002460 IF(T(IVP) .GE. RLENG) GO TO 130 00002470 T(IVP+1) = RLENG 00002480 DI = VA(IVP-1) * T(IVP-1) 00002490 DIP1 = VA(IVP) * T(IVP) 00002500 VINT = (DIP1-DI) / (T(IVP) - T(IVP-1)) 00002510 SUMD = DIP1 + (RLENG - T(IVP)) * VINT 00002520 VA(IVP+1) = SUMD / RLENG 00002530 IVP = IVP + 1 00002540 C 00002550 C REPLACE ORIGINAL INPUT DATA 00002560 C WITH ADJUSTED DATA 00002570 C 00002580 130 KOUNT = 3 00002590 C 00002600 DO 140 00002610 * JK = 1,IVP 00002620 VEL(KOUNT) = T(JK) 00002630 CALL ARMVE ( VR(JK),VEL(KOUNT+1),1 ) 00002640 KOUNT = KOUNT + 2 00002650 C 00002660 140 CONTINUE 00002670 C 00002680 C FILL IN THE SAMPLE CONTROL POINTS 00002690 C IN VSI BY LINEAR INTERPOLATION OF THE 00002700 C ACCUMUALTED VR INFORMATION. 00002710 C 00002720 TT = 0. 00002730 PTS = 0 00002740 C 00002750 150 DO 160 00002760 * I = 1, IVP 00002770 IF (T(I).GE.T(I+1)) GO TO 180 00002780 IF (TT.GE.T(I).AND.TT.LE.T(I+1)) GO TO 170 00002790 C 00002800 160 CONTINUE 00002810 C 00002820 GO TO 175 00002830 170 PTS = PTS + 1 00002840 Z1 = VA(I)*T(I)*.0005 00002850 Z2 = VA(I+1)*T(I+1)*.0005 00002860 VSI(PTS) = INT(Z1 + (((TT-T(I))*(Z2-Z1)) / (T(I+1)-T(I))) + .5) 00002870 TT = TT + SAMPR 00002880 IF (TT.LE.T(I+1)) GO TO 170 00002890 IF (TT.LE.RLENG) GO TO 150 00002900 IF ( PTS .GT. NSAMP ) PTS = NSAMP 00002910 PTS = PTS + 2 00002920 VSI(PTS-1) = 0 00002930 VSI(PTS) = 0 00002940 175 CONTINUE 00002950 C 00002960 RETURN 00002970 C 00002980 180 WRITE(IPR, 9000 ) TYP, T 00002990 GO TO 190 00003000 C 00003010 190 ERROR =-1 00003020 RETURN 00003030 C 00003040 C --- FORMAT STATEMENTS --- 00003050 C 00003060 9000 FORMAT (' *** BACKUP IN TIMES FOR ',A4/1X,'TIMES',5X, 00003070 * 20F6.0/4(11X,20F6.0/)) 00003080 END 00003090