CAINDMS2CVVA -- VELOCITY INFORMATION COLLECTION AND CONVERSION 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLE S2CVVA -- VELOCITY INFORMATION COLLECTION AND CONVERSION 00020000 CA AUTHOR HOOGSTRAAT 00030000 CA DESIGNER HOOGSTRAAT 00040000 CA LANGUAGE VSFORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN UNKNOWN 00070000 C 00080000 C REVISED 11-03-80 SAS - ZEROED OUT TIME ARRAY FOR EACH NEW 00090000 C VELOCITY FUNCTION IN S2CVVS INIT. 00100000 C REVISED 10-10-84 REP - CONVERT TO VS FORTRAN. RENAME NPTS 00110000 C TO MPTS FOR S2CVVT ENTRY. 00120000 C REVISED 12-19-84 LBL - FOR IBM AND CRAY. 00130000 C REVISED 10-21-85 REM - REMOVE EXTERNAL STATEMENT. 00140000 C REVISED 04-30-87 MJM - CHANGE ARMVE CALL TO AN EQUATE TO 00150000 C PREVENT BOUNDARY MISALIGNMENT ERRORS. 00160000 C REVISED 07-22-87 LWC - PUT IN CHECK TO MAKE SURE TIMES 00170000 C INCREASE IN VELOCITY FUNCTION. 00180000 C REVISED 08-10-87 ESN - SET VINTL CORRECTLY FOR USE IN 00190000 C EXTRAPOLATING THE FUNCTION WITH T/VI. 00200000 C REVISED 02-18-88 ESN - CALL USPVLF FOR TIME-VARYING 00210000 C PERCENT MODIFICATION. 00220000 C REVISED 10-03-88 MCD ADDED ARGUMENTS SPL AND KPRTF IN THE 00221000 C USPLVF CALL 00221100 C REVISED 10-11-88 MCD DELETED KPRTF VARIABLE FROM USIVLF 00221200 C CREATED A DIFFERENT SUBROUTINE USIVLF. 00221300 C REVISED 11-13-89 RDK FOR CRAY CFT77 COMPATIBILITY. 00221400 C REVISED 01-12-90 LWC FOR T0 BELOW DATUM, CHANGE THE WAY 00221502 C THE STARTING VELOCITY IS FOUND. 00221601 C (NOTE: CHANGE USVDAT ALSO IF DATUM 00221704 C METHODS ARE MODIFIED.) 00221804 C 00221900 CA 00222000 SUBROUTINE S2CVVA (TYP,INPUT,NPTS,DTDIST,RL,ISR,ERROR,IDATA,IPR) 00222100 CA 00222200 CA CALL S2CVVA(TYP,INPUT,NPTS,DTDIST,RL,ISR,ERROR,IDATA,IPR) 00222300 CA INPUT TYP = TYPE OF VELOCITY INFO. T/VR T/DT T/TX A4 00222400 CA Z/VR T/VA T/VI Z/VA Z/VI T/Z. 00223000 CA INPUT INPUT = ARRAY CONTAINING INPUT VELOCITY INFO I4 00224000 CA INPUT NPTS = NUMBER OF POINTS IN INPUT (NPTS/2 PAIRS) I4 00225000 CA INPUT DTDIST = INTEGER DISTANCE FOR 'T/DT' OR 'T/TX' I4 00226000 CA INPUT RL = INTEGER RECORD LENGTH IN MS I4 00227000 CA INPUT ISR = SAMPLE RATE I4 00228000 CA OUTPUT ERROR = RETURNED ERROR FLAG I4 00229000 CA INPUT IDATA = ORIGINAL INPUT DATA SAVED I4 00230000 CA INPUT IPR = INTERNAL PRINT UNIT I4 00240000 CA 00250000 CA 00260000 CA S2CVVA COLLECTS VELOCITY INFORMATION FOR CONVERSION INTO 00270000 CA RMS VELOCITIES BY S2CVVT. 00280000 CA 00290000 CAEND 00300000 CTITLE S2CVVS -- INITIALIZES S2CVVA 00310000 CA AUTHOR HOOGSTRAAT 00320000 CA DESIGNER HOOGSTRAAT 00330000 CA LANGUAGE S/370 FORTRAN H EXTENDED 00340000 CA WRITTEN UNKNOWN 00350000 C REVISED MO-DA-YR 00360000 C 00370000 CA 00380000 CA 00390000 CA CALL S2CVVS (NO ARGUMENTS) 00400000 CA 00410000 CA 00420000 CA INITIALIZES S2CVVA. 00430000 CAEND 00440000 CTITLE S2CVVT -- VELOCITY CONVERSION AND INTERPOLATION 00450000 CA AUTHOR HOOGSTRAAT 00460000 CA DESIGNER HOOGSTRAAT 00470000 CA LANGUAGE S/370 FORTRAN H EXTENDED 00480000 CA WRITTEN UNKNOWN 00490000 C REVISED 03-30-76 BY W. J. BROWN TO DELETE A 00500000 C LAYER ASSUMING CONSTANT VEL. 00510000 C REVISED 07-28-77 BY G.WHIPPLE - ADDED POLY- 00520000 C NOMIAL GENERATION OF VEL- 00530000 C OCITY FUNCTION. 00540000 C REVISED 02-11-79 BY P. COOPER DELETED CORRECTED 00550000 C VELOCITY POINTS PAST THE RECORD00560000 C LENGTH. 00570000 C REVISED 07-08-82 BY J. CROWLEY - ADDED PERCENT 00580000 C INPUT VELOCITY OPTION 00590000 C REVISED MM-DD-YY 00600000 CA 00610000 CA 00620000 CA CALL S2CVVT(COEF,VSI,ERROR,IDATA,IPR,TYPCOR,CRVELU,CRTMU,PCENT) 00630000 CA OUTPUT COEF = POLYNOMIAL COEFFICIENT ARRAY R4 00640000 CA OUTPUT VSI = VELOCITY SPACED AT THE SAMPLE INTERVAL I4 00650000 CA OUTPUT ERROR = RETURNED ERROR FLAG I4 00660000 CA INPUT IDATA = ORIGINAL INPUT DATA I4 00670000 CA INPUT IPR = INTERNAL PRINTER UNIT I4 00680000 CA INPUT TYPCOR = TYPE OF DATUM CORRECTION I4 00690000 CA INPUT CRVELU = CORRECTIONAL VELOCITY USED I4 00700000 CA INPUT CRTMU = CORRECTIONAL TIME USED I4 00710000 CA INPUT PCENT = PERCENT INPUT VELOCITY I4 00720000 CA 00730000 C 00740000 CA 00750000 CA S2CVVT COMPUTES THE VELOCITIES AT SAMPLE INTERVALS 00760000 CA FROM THE INFORMATION COLLECTED BY S2CVVA. 00770000 CAEND 00780000 C A MAXIMUM OF 100 CONTROL POINTS ON INPUT ARE ACCEPTED. 00790000 C 00800000 INTEGER S1CPCH 00810000 INTEGER TYP 00820000 INTEGER INPUT (1) 00830000 INTEGER NPTS 00840000 INTEGER MPTS 00850000 INTEGER DTDIST 00860000 INTEGER RL 00870000 INTEGER ERROR 00880000 INTEGER ORDER 00890000 INTEGER PCENT 00900000 INTEGER NX 00910000 C 00920000 INTEGER VSI (1) 00930000 INTEGER RLENG 00940000 INTEGER RMS 00950000 INTEGER TYPCOR 00960000 INTEGER CRVELU 00970000 INTEGER CRTMU 00980000 C 00990000 INTEGER TYPE (9) 01000000 INTEGER IDATA 01010000 C 01020000 REAL COEF(1) 01030000 REAL DEVTHS 01040000 REAL T (500) 01050000 REAL VA (500) 01060000 REAL VR (500) 01070000 REAL VI (500) 01080000 REAL DEV (500) 01090000 C 01100000 DIMENSION IDATA (1) 01110000 C 01120000 DATA T /500 * 0.0 / 01130000 DATA VA /500 * 0.0 / 01140000 DATA VR /500 * 0.0 / 01150000 DATA VI /500 * 0.0 / 01160000 DATA DEV /500 * 0.0 / 01170000 C 01180000 DATA INIT /1/ 01190000 DATA TYPE /'T/VR' , 'T/DT' , 'T/TX' , 01200000 * 'Z/VR' , 'T/VA' , 'T/VI' , 01210000 * 'Z/VA' , 'Z/VI' , 'T/Z ' / 01220000 DATA VELF / 'VELF' / 01230000 C 01240000 C RETURN IF NO POINTS INPUT 01250000 C AND HOLD SOME PARAMETERS. 01260000 C ALSO BOMB OFF IF S2CVVA IS NOT 01270000 C INITIALIZED VIA S2CVVS. 01280000 C 01290000 IF ( INIT .NE. 0 ) GO TO 370 01300000 IF ( NPTS .EQ. 0 ) RETURN 01310000 RLENG = RL 01320000 SAMPR = ISR 01330000 C SEARCH OUT THE PROPER CARD TYPE 01340000 C AND BOMB OFF IF ILLEGAL TYPE. 01350000 CMJM CALL ARMVE (TYP,IDATA(1),1) 01360000 IDATA(1) = TYP 01370000 DO 10 01380000 * ITYP = 1, 9 01390000 C IF ( TYP .EQ. TYPE(ITYP) ) GO TO 20 01400000 IF (S1CPCH(TYP,1,TYPE(ITYP),1,4) .EQ. 0) GO TO 20 01410000 C 01420000 10 CONTINUE 01430000 C 01440000 GO TO 380 01450000 C 01460000 C BRANCH TO APPROPRIATE PROCESSOR 01470000 C 01480000 20 GO TO ( 30 , 50 , 70 , 90 , 110 , 01490000 * 130 , 150 , 170 , 190 ) , ITYP 01500000 C 01510000 CX *********** 'T/VR'-CARD PROCESSOR ******************* 01520000 C 01530000 30 DO 40 01540000 * I = 1, NPTS, 2 01550000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 40 01560000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 01570000 IVP = IVP + 1 01580000 IDP = IDP + 2 01590000 IDATA(IDP)=INPUT(I) 01600000 IDATA(IDP+1)=INPUT(I+1) 01610000 T(IVP) = INPUT(I) 01620000 VR(IVP) = INPUT(I+1) 01630000 C 01640000 40 CONTINUE 01650000 C 01660000 RETURN 01670000 C 01680000 CX *********** 'T/DT'-CARD PROCESSOR ************************* 01690000 C 01700000 50 DO 60 01710000 * I = 1, NPTS, 2 01720000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 60 01730000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 01740000 IDP = IDP + 2 01750000 IDATA(IDP)=INPUT(I) 01760000 IDATA(IDP+1)=INPUT(I+1) 01770000 A = INPUT(I ) 01780000 B = IABS ( INPUT(I+1) ) 01790000 C = DTDIST * 1000.0 01800000 IVP = IVP + 1 01810000 T(IVP) = A 01820000 VR(IVP) = C / SQRT ( B * ( B + 2.0 * A ) ) 01830000 C 01840000 60 CONTINUE 01850000 C 01860000 RETURN 01870000 C 01880000 CX *************** 'T/TX'-CARD PROCESSOR ******************* 01890000 C 01900000 70 DO 80 01910000 * I = 1, NPTS, 2 01920000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 80 01930000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 01940000 IDP = IDP + 2 01950000 IDATA(IDP)=INPUT(I) 01960000 IDATA(IDP+1)=INPUT(I+1) 01970000 A = INPUT(I ) 01980000 B = INPUT(I+1) 01990000 IF ( B .LT. A ) GO TO 400 02000000 C = DTDIST * 1000.0 02010000 IVP = IVP + 1 02020000 T(IVP) = A 02030000 VR(IVP) = C / SQRT ( B*B - A*A ) 02040000 C 02050000 80 CONTINUE 02060000 C 02070000 RETURN 02080000 C 02090000 CX *************** 'Z/VR'-CARD PROCESSOR ******************* 02100000 C 02110000 90 DO 100 02120000 * I = 1, NPTS, 2 02130000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 100 02140000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 02150000 IDP = IDP + 2 02160000 IDATA(IDP)=INPUT(I) 02170000 IDATA(IDP+1)=INPUT(I+1) 02180000 IVP = IVP + 1 02190000 T(IVP) = 2000.0 * INPUT(I) / INPUT(I+1) 02200000 VR(IVP) = INPUT(I+1) 02210000 C 02220000 100 CONTINUE 02230000 C 02240000 RETURN 02250000 C 02260000 CX *************** 'T/VA'-CARD PROCESSOR ******************** 02270000 C 02280000 110 DO 120 02290000 * I = 1, NPTS, 2 02300000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 120 02310000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 02320000 IDP = IDP + 2 02330000 IDATA(IDP)=INPUT(I) 02340000 IDATA(IDP+1)=INPUT(I+1) 02350000 IVP = IVP + 1 02360000 T(IVP) = INPUT(I) 02370000 VA(IVP) = INPUT(I+1) 02380000 C 02390000 120 CONTINUE 02400000 C 02410000 RMS = 0 02420000 RETURN 02430000 C 02440000 CX *************** 'T/VI'-CARD PROCESSOR ******************** 02450000 C 02460000 130 CONTINUE 02470000 DO 140 02480000 * I = 1, NPTS, 2 02490000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 140 02500000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 02510000 IDP = IDP + 2 02520000 IDATA(IDP)=INPUT(I) 02530000 IDATA(IDP+1)=INPUT(I+1) 02540000 VINTL = INPUT(I+1) 02550000 IT = INPUT(I) 02560000 IF ( IVP.EQ. 0 ) IT = 0 02570000 IF ( IVP.EQ. 0 ) Z = 0 02580000 IF ( IVP.EQ. 0 ) ITL = 0 02590000 IF ( IVP.EQ. 0 ) IVL = 0 02600000 Z = Z + ( IT - ITL ) * IVL 02610000 IVL = INPUT(I+1) 02620000 ITL = IT 02630000 IVP = IVP + 1 02640000 T(IVP) = IT 02650000 IF (IT.GT.0) VA(IVP) = Z / IT 02660000 IF (IT.EQ.0) VA(IVP) = INPUT(I+1) 02670000 C 02680000 140 CONTINUE 02690000 C 02700000 RMS = 0 02710000 RETURN 02720000 C 02730000 CX *************** 'Z/VA'-CARD PROCESSOR ******************* 02740000 C 02750000 150 DO 160 02760000 * I = 1, NPTS, 2 02770000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 160 02780000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 02790000 IDP = IDP + 2 02800000 IDATA(IDP)=INPUT(I) 02810000 IDATA(IDP+1)=INPUT(I+1) 02820000 IVP = IVP + 1 02830000 T(IVP) = 2000.0 * INPUT(I) / INPUT(I+1) 02840000 VA(IVP) = INPUT(I+1) 02850000 C 02860000 160 CONTINUE 02870000 C 02880000 RMS = 0 02890000 RETURN 02900000 C 02910000 CX *************** 'Z/VI'-CARD PROCESSOR ******************* 02920000 C 02930000 170 DO 180 02940000 * I = 1, NPTS, 2 02950000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 180 02960000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 02970000 IDP = IDP + 2 02980000 IDATA(IDP)=INPUT(I) 02990000 IDATA(IDP+1)=INPUT(I+1) 03000000 VINTL = INPUT(I+1) 03010000 Z = INPUT(I) 03020000 IF (IVP.EQ. 0 ) Z = 0 03030000 IF (IVP.EQ. 0 ) IVL= 9999999 03040000 IF (IVP.EQ. 0 ) TL = 0 03050000 IF (IVP.EQ. 0 ) ZL = 0 03060000 IVP = IVP + 1 03070000 TL = TL + ( Z - ZL ) / IVL * 2000.0 03080000 ZL = Z 03090000 IVL = INPUT(I+1) 03100000 T(IVP) = TL 03110000 IF ( Z .EQ. 0. ) VA(IVP) = INPUT(I+1) 03120000 IF ( Z .GT. 0. ) VA(IVP) = Z / TL * 2000.0 03130000 C 03140000 180 CONTINUE 03150000 C 03160000 RMS = 0 03170000 RETURN 03180000 C 03190000 CX *************** 'T/Z '-CARD PROCESSOR ******************* 03200000 C 03210000 190 DO 200 03220000 * I = 1, NPTS, 2 03230000 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 200 03240000 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 410 03250000 IDP = IDP + 2 03260000 IDATA(IDP)=INPUT(I) 03270000 IDATA(IDP+1)=INPUT(I+1) 03280000 IT = INPUT(I) 03290000 IVP = IVP + 1 03300000 T(IVP) = IT 03310000 VA(IVP) = 2000.0 * INPUT(I+1) / IT 03320000 C 03330000 200 CONTINUE 03340000 C 03350000 RMS = 0 03360000 RETURN 03370000 C 03380000 C---------------------------------------------------------------------- 03390000 C 03400000 ENTRY S2CVVS 03410000 C 03420000 CX S2CVVS ENTRY -- INITIALIZE FOR VELOCITY 03430000 CX VELOCITY CONVERSION. 03440000 C 03450000 INIT = 0 03460000 IVP = 0 03470000 Z = 0.0 03480000 ZL = 0.0 03490000 TL = 0.0 03500000 VINTL = 0.0 03510000 IDP = 1 03520000 RMS = 1 03530000 C 03540000 CALL ARSET (T, 500, 0.0) 03550000 C 03560000 RETURN 03570000 C 03580000 C---------------------------------------------------------------------- 03590000 C 03600000 ENTRY S2CVVT (COEF,VSI,ERROR,IDATA,IPR,TYPCOR,CRVELU,CRTMU, 03610000 * ORDER,DEVTHS,PCENT,SPL,KPRTF) 03620000 C 03630000 CX S2CVVT ENTRY--COMPUTE AN RMS VELOCITY AT SAMPR 03640000 CX INTERVALS AND RETURN IT IN INTEGER 03650000 CX ARRAY VSI. 03660000 C 03670000 IF (ORDER .EQ. 0) GO TO 205 03680000 C 03690000 C SORT THE INPUT TIME VELOCITY PAIRS 03700000 C 03710000 CALL USSRTC (IVP, 1, 'INCR', 3, T, VA) 03720000 205 CONTINUE 03730000 C 03740000 C 03750000 C LWC CHECK TO MAKE SURE TIMES INCREASE 03760000 C 03770000 DO 207 03780000 * I = 2, IVP 03790000 IF (T(I) .LE. T(I-1)) GO TO 360 03800000 207 CONTINUE 03810000 C LWC 03820000 C 03830000 C 205 IF (T(IVP).GE.RLENG) GO TO 220 03840000 IF (T(IVP).GE.RLENG) GO TO 220 03850000 IF (IVP.GT.1) GO TO 210 03860000 C 03870000 C INSERT A CONTROL POINT AT TIME(RLENG) 03880000 C IF REQUIRED. 03890000 C 03900000 T(IVP+1) = RLENG 03910000 VA(IVP+1) = VA(IVP) 03920000 IF (VINTL.GT.0.) VA(IVP+1) = VINTL 03930000 VR(IVP+1) = VR(IVP) 03940000 IF (VINTL.GT.0.) VR(IVP+1) = VINTL 03950000 IVP = IVP + 1 03960000 GO TO 220 03970000 C 03980000 210 T(IVP+1) = RLENG 03990000 D1 = VA(IVP-1) * T(IVP-1) 04000000 D2 = VA(IVP) * T(IVP ) 04010000 VINT = (D2-D1)/(T(IVP)-T(IVP-1)) 04020000 IF (VINTL.GT.0.) VINT = VINTL 04030000 D3 = D2 + (RLENG - T(IVP)) * VINT 04040000 VA(IVP+1) = D3 / RLENG 04050000 D1 = VR(IVP-1) * T(IVP-1) 04060000 D2 = VR(IVP) * T(IVP ) 04070000 VINT = (D2-D1)/(T(IVP)-T(IVP-1)) 04080000 IF (VINTL.GT.0.) VINT = VINTL 04090000 D3 = D2 + (RLENG - T(IVP)) * VINT 04100000 VR(IVP+1) = D3 / RLENG 04110000 IVP = IVP + 1 04120000 C 04130000 C DUPLICATE FIRST POINT FOR TIME(0) 04140000 C IF TIME(0) IS MISSING. 04150000 C 04160000 220 IF(T(1).EQ.0.) GO TO 230 04170000 CALL ARMVE (T (1),T (2),IVP) 04180000 CALL ARMVE (VA(1),VA(2),IVP) 04190000 CALL ARMVE (VR(1),VR(2),IVP) 04200000 NX = 3 04210000 C CALL ARMVE (IDATA(3),IDATA(5),IVP*2) 04220000 CALL ARMVE (IDATA(NX),IDATA(NX+2),IVP*2) 04230000 T(1) = 0. 04240000 C IDATA(3) = 0. 04250000 IDATA(NX) = 0. 04260000 IDP = IDP + 2 04270000 IVP = IVP + 1 04280000 C CHECK FOR CORRECTION OF THE 04290000 C VELOCITY BY THE ADDITION 04300000 C OR DELETION OF A LAYER. 04310000 C 04320000 230 IF (RMS.NE.0.AND.TYPCOR.EQ.0) GO TO 330 04330000 IF (RMS.EQ.0.AND.TYPCOR.EQ.0) GO TO 310 04340000 IF (RMS.EQ.0)GO TO 260 04350000 C 04360000 C CONVERT RMS TO AVERAGE VELOCITIES 04370000 C TO MAKE THE CORRECTIONS. 04380000 C 04390000 C 04400000 VA(1) = VR(1) 04410000 C 04420000 C COMPUTE THE INTERMEDIATE INTERVAL VELOCITIES. 04430000 C 04440000 IVPM1 = IVP - 1 04450000 C 04460000 DO 240 04470000 * I = 1,IVPM1 04480000 VI(I)=(VR(I+1)*VR(I+1)*T(I+1) 04490000 * - VR(I)*VR(I)*T(I))/(T(I+1)-T(I)) 04500000 IF(VI(I).LT.0.) VI(I) = 0.0 04510000 VI(I) = SQRT(VI(I)) 04520000 C 04530000 240 CONTINUE 04540000 C 04550000 C COMPUTE THE AVERAGE VELOCITIES. 04560000 C 04570000 SUMVT = 0. 04580000 C 04590000 DO 250 04600000 * I = 2,IVP 04610000 SUMVT = SUMVT + VI(I-1)*(T(I)-T(I-1)) 04620000 VA(I) = SUMVT/T(I) 04630000 250 CONTINUE 04640000 C 04650000 C ADJUST THE AVERAGE VELOCITIES BY A LAYER 04660000 C DEFINED FROM TIME ZERO TO 'CRTMU' HAVING 04670000 C A VELOCITY OF 'CRVELU'. 04680000 C 04690000 C 290 04700000 C 04710000 C INSERT OR DELETE THE CORRECTIONAL LAYER 04720000 C 04730000 260 KNT = 1 04740000 C 04750000 DO 270 04760000 * I = 2,IVP 04770000 IF (T(I).GT.CRTMU) GO TO 270 04780000 KNT = I 04790000 C 04800000 270 CONTINUE 04810000 KNT =KNT + 1 04820000 C 04830000 IF (TYPCOR .GT. 0) THEN 04840000 KNT = 2 04850000 KNT2 = IVP + 1 04850100 VAX = CRVELU 04850200 ELSE 04850300 IF ( T(KNT) .EQ. T(KNT-1)) THEN 04850400 VAX = VA(KNT) 04850500 GO TO 275 04850600 ENDIF 04850700 VAX = VA(KNT-1) + (CRTMU-T(KNT-1))*(VA(KNT)-VA(KNT-1)) / 04850800 * (T(KNT)-T(KNT-1)) 04850900 KNT2 = 2 04851000 ENDIF 04852000 275 CONTINUE 04853000 C 04854000 DO 280 04855000 * I = KNT,IVP 04856000 IF (TYPCOR .GT. 0 ) KNT1 = KNT2 - 1 04857000 IF (TYPCOR .LE. 0 ) KNT1 = I 04858000 VA(KNT2) = VA(KNT1) 04859000 T (KNT2) = T(KNT1) 04860000 IF (TYPCOR .GT. 0 ) KNT2 = KNT2 - 1 04870000 IF (TYPCOR .LE. 0 ) KNT2 = KNT2 + 1 04880000 C 04890000 280 CONTINUE 04900000 C 04910000 IF (TYPCOR .GT. 0 ) IVP = IVP + 1 04920000 IF (TYPCOR .LE. 0 ) IVP = IVP - (KNT-2) 04930000 C 04940000 290 IF ( TYPCOR .GT. 0 ) GO TO 295 04950000 TNEW = T(KNT) - CRTMU 04960000 VNEW = (VA(KNT)*T(KNT) - CRTMU*VAX) / (T(KNT)-CRTMU) 04970000 IF ( TNEW.NE.4. ) GO TO 291 04980000 VA (1) = VNEW 04990000 GO TO 292 05000000 291 VDIF = VA(KNT) - VAX 05010000 C VFOUR = (( 4.*VDIF ) / TNEW ) + VAX 05020000 C VTWO = (VFOUR*(CRTMU+4.)-CRTMU*VAX) / 4. 05030000 C VA(1) = VNEW - ((TNEW*(VNEW-VTWO)) / (TNEW-4.)) 05040000 VA(1) = VAX 05050000 292 VA(2) = VNEW 05060000 T( 2 ) = TNEW 05070000 T(1) = 0. 05080000 C 05090000 GO TO 297 05134000 C 05135000 295 VA (1) = CRVELU 05136000 VA (2) = CRVELU 05137000 T ( 2) = CRTMU 05138000 C 05139000 C NOW ADJUST THE FUNCTION 05140000 C 05150000 297 IVPM1 = IVP - 1 05160000 C 05170000 C 05222000 J = 2 05223000 C 05224000 DO 300 05225000 * I = 3,IVP 05226000 J = J + 1 05227000 IF (TYPCOR.GT.0) 05228000 * VA(J) = (CRTMU*CRVELU+T(I)*VA(I)) / (CRTMU+T(I)) 05229000 IF (TYPCOR.LT.0) 05230000 * VA(J) = (T(I)*VA(I)-CRTMU*VAX) / (T(I)-CRTMU) 05240000 IF(TYPCOR.NE.0) T(J) = T(I) + TYPCOR 05250000 IF(T(J).GT.T(J-1)) GO TO 300 05260000 J = J - 1 05270000 300 CONTINUE 05280000 C 05290000 IVP = J 05300000 C 05310000 IF(T(IVP) .GE. RLENG) GO TO 310 05320000 T(IVP+1) = RLENG 05330000 D1 = VA(IVP-1) * T(IVP-1) 05340000 D2 = VA(IVP) * T(IVP) 05350000 VINT = (D2-D1) / (T(IVP) - T(IVP-1)) 05360000 D3 = D2 + (RLENG - T(IVP)) * VINT 05370000 VA(IVP+1) = D3 / RLENG 05380000 IVP = IVP + 1 05390000 C 05400000 310 IF(T(IVP) .EQ. RLENG) GO TO 318 05410000 JVP = IVP 05420000 312 JVP = JVP - 1 05430000 IF (T(JVP) .GT. RLENG) GO TO 312 05440000 IF (T(JVP) .LT. RLENG) GO TO 316 05450000 LVP = JVP + 1 05460000 JVP = JVP - 1 05470000 C 05480000 313 DO 314 05490000 * L = LVP, IVP 05500000 T(L) = 0 05510000 VA(L) = 0.0 05520000 314 CONTINUE 05530000 C 05540000 IVP = JVP + 1 05550000 GO TO 318 05560000 C 05570000 316 D1 = VA(JVP) * T(JVP) 05580000 D2 = VA(JVP+1) * T(JVP+1) 05590000 VINT = (D2 - D1) / (T(JVP+1) - T(JVP)) 05600000 D3 = D1 + (RLENG - T(JVP)) * VINT 05610000 VA(JVP+1) = D3 / RLENG 05620000 T(JVP+1) = RLENG 05630000 LVP = JVP + 2 05640000 IF(LVP .LE. IVP) GO TO 313 05650000 IVP = JVP + 1 05660000 C 05670000 318 CONTINUE 05680000 C 05690000 IF (ORDER .EQ. 0) GO TO 339 05700000 C 05710000 C FIT A POLYNOMIAL OF ORDER ORDER TO THE INPUT 05720000 C AVERAGE VELOCITY FUNCTION. 05730000 C 05740000 IF (IVP .LT. (ORDER*ORDER+3*ORDER+2)/2) GO TO 367 05750000 T(1) = T(1)/1000. 05760000 DO 33510 05770000 * I=2,IVP 05780000 T(I) = T(I)/1000. 05790000 C** IF (T(I) .GT. T(I-1) ) GO TO 33510 05800000 C** GO TO 390 05810000 33510 CONTINUE 05820000 CALL MSFIT(T,VA,ORDER,COEF,IVP) 05830000 NCOEF = ORDER+1 05840000 SUMDEV = 0.0 05850000 DO 33520 05860000 * I = 1,IVP 05870000 VTST = COEF(NCOEF) 05880000 DO 33515 05890000 * K = 1,ORDER 05900000 33515 VTST = VTST*T(I) + COEF(NCOEF-K) 05910000 DEV(I) = ABS(VTST-VA(I)) 05920000 33520 SUMDEV = SUMDEV + DEV(I) 05930000 DEVIAT = (SUMDEV/IVP)*DEVTHS 05940000 C 05950000 KVP = 0 05960000 DO 33530 05970000 * I = 1,IVP 05980000 IF ( DEV(I) .GT. DEVIAT ) GO TO 33530 05990000 KVP = KVP + 1 06000000 T(KVP) = T(I) 06010000 VA(KVP) = VA(I) 06020000 33530 CONTINUE 06030000 C 06040000 C 06101000 IF (KVP .LT.(ORDER*ORDER+3*ORDER+2)/2) GO TO 365 06102000 IF (KVP .LT. IVP) 06103000 * CALL MSFIT(T,VA,ORDER,COEF,KVP) 06104000 C 06105000 C 06106000 C REPLACE ORIGINAL AVERAGE VELOCITY FUNCTION 06107000 C BY POLYNOMIAL GENERATED 'AVERAGE' VELOCITY 06108000 C FUNCTION COMPUTED AT 50 MS INTERVALS. 06109000 C 06110000 IVP = (RLENG+49)/50 06120000 IF (IVP .GT.249) IVP = 249 06130000 DO 33555 06140000 * I=1,IVP 06150000 33555 T(I) = (I-1)*.050 06160000 IVP = IVP + 1 06170000 T(IVP) = RLENG/1000. 06180000 DO 33565 06190000 * I=1,IVP 06200000 VTST = COEF(NCOEF) 06210000 DO 33560 06220000 * K=1,ORDER 06230000 33560 VTST = VTST*T(I) + COEF(NCOEF-K) 06240000 T(I) = AINT(1000.*T(I) + .5) 06250000 33565 VA(I) = VTST 06260000 C 06270000 C 06350000 C 06360000 339 CONTINUE 06370000 C 06380000 C CONVERT AVERAGE TO RMS 06390000 C 06400000 SUMVT = 0. 06410000 C 06420000 DO 320 06430000 * I = 2,IVP 06440000 TINT = T(I) - T(I-1) 06450000 IF (TINT.LE.0.)GO TO 320 06460000 VINT = (VA(I)*T(I)-VA(I-1)*T(I-1))/TINT 06470000 SUMVT = SUMVT + VINT*VINT*TINT 06480000 IF(SUMVT .LT. 0.) SUMVT = 0.0 06490000 C 06500000 320 VR(I) = SQRT (SUMVT / T(I)) 06510000 C 06520000 VR(1) = VA(1) 06530000 C 06540000 C REPLACE ORIGINAL INPUT DATA 06550000 C WITH ADJUSTED DATA 06560000 C 06570000 330 KOUNT = 3 06580000 C 06590000 CALL USIVLF (VELF, 0, T, VR, IVP, IPR,SPL,KPRTF) 06600000 C 06610000 DO 335 06620000 * JK = 1,IVP 06630000 IDATA(KOUNT) = T(JK) 06640000 VR(JK) = VR(JK) * PCENT/100. 06650000 CALL ARMVE ( VR(JK),IDATA(KOUNT+1),1 ) 06660000 KOUNT = KOUNT + 2 06670000 C 06680000 335 CONTINUE 06690000 INIT = 1 06700000 NX = 2 06710000 IDATA (NX)= IVP*2 06720000 C IDATA (2) = IVP*2 06730000 IVP = IVP - 1 06740000 C 06750000 C 06760000 C 06770000 C FILL IN THE SAMPLE CONTROL POINTS 06780000 C IN VSI BY LINEAR INTERPOLATION OF THE 06790000 C ACCUMUALTED VR INFORMATION. 06800000 C 06810000 TT = 0. 06820000 MPTS = 0 06830000 C 06840000 C 06850000 540 DO 550 06860000 * I = 1, IVP 06870000 IF (T(I).GE.T(I+1)) GO TO 390 06880000 IF (TT.GE.T(I).AND.TT.LE.T(I+1)) GO TO 560 06890000 C 06900000 550 CONTINUE 06910000 C 06920000 560 MPTS = MPTS + 1 06930000 VSI(MPTS)=INT((TT-T(I))*(VR(I+1)-VR(I))/(T(I+1)-T(I))+VR(I)+.5) 06940000 TT = TT + SAMPR 06950000 IF (TT.LE.RLENG) GO TO 540 06960000 C 06970000 562 RETURN 06980000 C 06990000 C 07000000 C 07010000 C 07020000 C 07030000 C 07040000 360 WRITE(IPR, 9060) TYP, (T(I), I = 1, IVP) 07050000 GO TO 420 07060000 C 07070000 C 07080000 365 WRITE(IPR, 9050) DEVTHS 07090000 GO TO 420 07100000 C 07110000 367 WRITE(IPR,9055) ORDER 07120000 GO TO 420 07130000 C 07140000 370 WRITE(IPR, 9000 ) 07150000 GO TO 420 07160000 C 07170000 380 WRITE(IPR, 9010 ) TYP 07180000 GO TO 420 07190000 C 07200000 390 WRITE(IPR, 9020 ) TYP, T 07210000 GO TO 420 07220000 C 07230000 400 WRITE(IPR, 9030 ) TYP, ( INPUT(I), I = 1, NPTS ) 07240000 GO TO 420 07250000 C 07260000 410 WRITE(IPR, 9040 ) TYP, ( INPUT(I), I = 1, NPTS ) 07270000 C 07280000 420 ERROR =-1 07290000 RETURN 07300000 C 07310000 C --- FORMAT STATEMENTS --- 07320000 C 07330000 9000 FORMAT (' *** S2CVVA NOT INITIALIZED VIA S2CVVS.') 07340000 C 07350000 9010 FORMAT (' *** ILLEGAL VELOCITY TYPE ',A4,'.') 07360000 C 07370000 9020 FORMAT (' *** BACKUP IN TIMES FOR ',A4/1X,'TIMES',5X, 07380000 * 20F6.0/4(11X,20F6.0/)) 07390000 C 07400000 9030 FORMAT (' *** TX IS LESS THAN T0. CARD IN ERROR-- ',A4,1X, 07410000 * 14I5/20(46X,14I5/)) 07420000 C 07430000 9040 FORMAT (' *** VELOCITY FUNCTION CARD IN ERROR-- ',A4,1X, 07440000 * 14I5/20(46X,14I5/)) 07450000 C 07460000 9050 FORMAT (' *** DEVIATION THRESHOLD OF',F10.4,' (DF15 CARD 1)', 07470000 * ' RESULTED IN THE REJECTION'/4X,'OF AN UNACCEPTABLE', 07480000 * ' NUMBER OF THE INPUT CONTROL POINTS.') 07490000 C 07500000 9055 FORMAT (' *** NUMBER OF VELOCITY CONTROL POINTS IS LESS THAN ',07510000 * 'THE MINIMUM NUMBER'/4X,'REQUIRED FOR PROPER CURVE ', 07520000 * 'FITTING WITH A POLYNOMIAL OF DEGREE',I3, 07530000 * ' (DF14 CARD 1)') 07540000 C 07550000 9060 FORMAT (' ** TIMES OF FUNCTION IN ERROR FOR ',A4/1X,'TIMES',5X,07560000 * 20F6.0/4(11X,20F6.0/)) 07570000 END 07580000