CTITLES2VPLT -- PRINTER PLOT OF A VELOCITY FUNCTION 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR HOOGSTRAAT / MENDEKE 00000200 CA DESIGNER HOOGSTRAAT / MENDEKE 00000300 CA LANGUAGE FORTRAN 00000401 CA SYSTEM IBM AND CRAY 00000500 CA WRITTEN 01-01-75 00000600 C REVISED 04-08-76 J. MENDEKE - MAJOR REVISIONS 00000700 C REVISED 06-09-77 WHIPPLE - ARRAY SIZES INCREASED 00000800 C TO HANDLE 250 VELOCITY-TIME PAIRS00000900 C REVISED 07-12-82 J. CROWLEY - ADDED OPTION FOR 00001000 C PERCENT INPUT VELOCITY 00001100 C REVISED 09-22-82 R. KNIGHT - REVISED TO COMPUTE 00001200 C INTERVAL AND AVERAGE VELOCITIES 00001300 C FROM VRMS VELOCITIES 00001400 C REVISED 10-01-82 P. COOPER - ADDED CHECK FOR NEGATIVE VI BEFORE 00001800 C PERFORMING SQRT. 00001900 C REVISED 10-03-84 LBL - USE DATA STATEMENTS TO INITIALIZE 00002000 C VARIABLES TO FIT CRAY COMPILER. 00002100 C MAKE SURE SAME MIN VELOCITY IS OBTAINED ON 00002201 C BOTH MACHINES. 00002301 C REVISED 11-13-89 RDK FOR CRAY CFT77 COMPATIBILITY. 00002402 C 00002501 SUBROUTINE S2VPLT(VELORG, DIPCOR,VRMS,RLENG,SAMPR,IDNO ,VINCP, 00002600 * DTDIST,DATVEL,DATUM,IPR,PCENT) 00002700 C 00002800 IMPLICIT INTEGER (A-Z) 00002900 C EXTERNAL S1ATP 00003001 CA 00003100 CA 00003200 CA CALL S2VPLT(VELORG,DIPCOR, VRMS,RLENG,SAMPR,POINT,VINCP, 00003300 CA DTDIST,DATVEL,IPR,PCENT) 00003400 CA 00003500 CA INPUT VELORG = ORIGINAL INPUT DATA VALUES. 00003600 CA INPUT DIPCOR = DIP CORRECTION TO ORIGINAL INPUT 00003700 CA INPUT VRMS = ARRAY OF RMS VELOCITIES. I4 00003800 CA INPUT RLENG = RECORD LENGTH IN MS. I4 00003900 CA INPUT SAMPR = SAMPLE RATE IN MS. I4 00004000 CA INPUT IDNO = VELOCITY FUNCTION ID. I4 00004100 CA INPUT VINCP = TIME INCREMENT FOR VELOCITY PRINT. I4 00004200 CA INPUT DTDIST = X-DISTANCE AT WHICH TO COMPUTE I4 00004300 CA AND PRINT DELTA-T'S. I4 00004400 CA INPUT DATVEL = ORIGINAL INPUT DATA CONVERTED TO RMS. I4 00004500 CA INPUT DATUM = DATUM ELEVATION 00004600 CA INPUT IPR = INTERNAL PRINTER UNIT I4 00004700 CA INPUT PCENT = PERCENT INPUT VELOCITY I4 00004800 CA 00004900 CA 00005000 CA S2VPLT PRODUCES A PRINTER PLOT OF A RMS VELOCITY FUNCTION 00005100 CA AND ITS RELATIVE DEPTH, INTERVAL VELOCITY AND AVERAGE VELOCITY 00005200 CA FUNCTIONS. 00005300 CC ====================================================== 00005400 CC * PROGRAM DEVELOPED BY 00005500 CC * H * HOOGSTRAAT PROGRAMMING SERVICES LTD. 00005600 CC * P S * BOX 20, SITE 7, SS #1 00005700 CC * * * * * * * CALGARY, ALTA. CANADA PH 288-8088 00005800 CC ====================================================== 00005900 CC 00006000 C 00006100 C INTEGER ARRAYS 00006200 C 00006300 INTEGER VRMS (1) 00006400 INTEGER LINE (98) 00006500 INTEGER DATVEL (502) 00006600 INTEGER DATTM (250) 00006700 INTEGER VELORG (502) 00006800 INTEGER TMORG (250) 00006900 INTEGER VLORG (250) 00007000 C 00007100 C 00007200 C INTEGER VARIABLES AND CONSTANTS 00007300 C 00007400 DATA FIRST /1/ 00007500 DATA RRRR /'RRRR'/ 00007600 DATA AAAA /'AAAA'/ 00007700 DATA IIII /'IIII'/ 00007800 DATA DOT /'||||'/ 00007900 DATA BLNK /' '/ 00008000 DATA PTIM /'TIME'/ 00008100 DATA PZZZ /' Z '/ 00008200 C 00008300 C 00008400 C 00008500 C 00008600 C REAL ARRAYS 00008700 C 00008800 C 00008900 REAL DIPCOR(502) 00009000 REAL DIPORG(250) 00009100 C 00009200 REAL DATVR (250) 00009300 REAL DATVI (250) 00009400 REAL DATVA (250) 00009500 REAL DATZZ (250) 00009600 C 00009700 C REAL VARIABLES AND CONSTANTS 00009800 C 00009900 DOUBLE PRECISION SUMVT 00010001 REAL DIST 00010100 REAL XMINV 00010200 REAL SCALE 00010300 REAL FSAMP 00010400 REAL ASAMP 00010500 REAL VA 00010600 REAL DT 00010700 REAL T 00010800 REAL TP 00010900 REAL VI 00011000 REAL X 00011100 REAL XX 00011200 C 00011300 C 00011400 C 00011500 C 00011600 C 00011700 C 00011800 C INITIALIZE 00011900 C =========== 00012000 C 00012100 C 00012200 IF(1.EQ.2) CALL S1ATP 00012301 C 00012401 NPTS = RLENG / SAMPR + 1 00012500 IF (VINCP .LT. SAMPR) VINCP = SAMPR 00012600 IVINCP = VINCP/SAMPR 00012700 DIST = DTDIST 00012800 C 00012900 C 00013000 C MOVE THE ORIGINAL INPUT TO PRINT ARRAYS 00013100 C 00013200 MN = VELORG(2) + 2 00013300 MVP = (MN-2) / 2 00013400 K = 1 00013500 C 00013600 DO 5 I = 3, MN, 2 00013700 TMORG(K) = VELORG(I) 00013800 VLORG(K) = VELORG(I+1) 00013900 DIPORG(K)= DIPCOR(I+1) 00014000 K = K + 1 00014100 5 CONTINUE 00014200 C 00014300 P1 = BLNK 00014400 P2 = BLNK 00014500 P1 = PZZZ 00014600 IF (S1CPCH(VELORG(1),1,'T',1,1).EQ. 0)P1 = PTIM 00014700 CALL S1MVCH(VELORG(1),3,P2,3,2) 00014800 C 00014900 C MOVE INPUT RMS VELOCITIES TO DATVR 00015000 C 00015100 N = DATVEL(2) + 2 00015200 IVP = (N-2) / 2 00015300 K = 1 00015400 IF(FIRST .EQ. 1)CALL ARMVE (DATVEL(4), XMINV, 1) 00015500 C 00015600 DO 10 I = 3, N, 2 00015700 DATTM(K) = DATVEL (I) 00015800 CALL ARMVE (DATVEL(I+1), DATVR(K), 1) 00015900 IF (DATVR(K).LT.XMINV .AND. FIRST.EQ.1) XMINV = DATVR(K) 00016000 K = K + 1 00016100 10 CONTINUE 00016200 IF (FIRST .EQ. 0) GO TO 15 00016300 FIRST = 0 00016400 C SET THE MINIMUM AND MAXIMUM VELOCITIES, 00016500 C REQUIRED FOR PLOTTING SCALES. INCREMENT 00016600 C IS 250 PER PRINTER POSITION. 00016700 C 00016800 C 00016901 C MINV = XMINV - 2000 TRUNCATE DIFFERENTLY ON CRAY...... 00017001 MINV = (XMINV + 1.0) - 2000 00017101 MINV = MINV / 1000 * 1000 00017400 XMINV = MINV 00017700 MAXV = 26500 - (4000 - MINV) 00017800 C 00017900 C PRINT TITLE AND COMPUTE PLOTTING SCALE. 00018000 C 00018100 15 WRITE(IPR, 9000 ) IDNO ,DTDIST, DATUM , PCENT 00018200 WRITE(IPR, 9005 )MINV,MAXV 00018300 C 00018400 SCALE = 97. / ( MAXV - MINV ) 00018500 C 00018600 C CONVERT RMS TO INTERVAL VELOCITIES 00018700 C 00018800 IVPM1 = IVP - 1 00018900 C 00019000 DO 20 I = 1, IVPM1 00019100 DATVI (I) = (DATVR(I+1)*DATVR(I+1)*DATTM(I+1) - 00019200 * DATVR(I)*DATVR(I)*DATTM(I))/(DATTM(I+1)-DATTM(I)) 00019300 IF(DATVI(I) .LT. 0.) DATVI(I) = 0. 00019400 DATVI(I) = SQRT (DATVI(I)) 00019500 20 CONTINUE 00019600 C 00019700 C COMPUTE THE AVERAGE VELOCITIES AND DEPTHS 00019800 C 00019900 SUMVT = 0. 00020000 DATVA(1) = DATVR(1) 00020100 DATZZ(1) = 0. 00020200 C 00020300 DO 30 I = 2, IVP 00020400 SUMVT = SUMVT + DATVI(I-1)*(DATTM(I)-DATTM(I-1)) 00020500 DATVA(I) = SUMVT / DATTM(I) 00020600 DATZZ(I) = DATVA(I) * DATTM(I) / 2000. 00020700 30 CONTINUE 00020800 C 00020900 C INITIALIZE FOR START OF PLOT 00021000 C 00021100 C 00021200 FSAMP = SAMPR / 1000. 00021300 ASAMP = FSAMP * IVINCP 00021400 T = 0. 00021500 M = 0 00021600 SUMVT = 0. 00021700 C 00021800 IIJ = 0 00021900 IVI = 0. 00022000 ILL = 1 00022100 VA = VRMS(1) 00022200 C 00022300 II = 0 00022400 LLAST = 1 00022500 L = 1 00022600 C 00022700 DO 190 00022800 * I = 1, NPTS , IVINCP 00022900 C 00023000 M = M + 1 00023100 T = (I-1)*FSAMP 00023200 C 00023300 DO 110 00023400 * K = 1, 98 00023500 C 00023600 110 LINE(K) = BLNK 00023700 C 00023800 LINE(1) = DOT 00023900 LINE(98) = DOT 00024000 C 00024100 C PRINT THE INPUT FUNTIONS 00024200 C 00024300 IF(M .EQ. 2) WRITE(IPR, 9010) 00024400 IF(M .EQ. 3) WRITE(IPR, 9015) 00024500 IF(M .EQ. 4) WRITE(IPR, 9020) P1, P2 00024600 IF (M .LE. 4) GO TO 115 00024700 C 00024800 IF(IIJ .GE. MVP) GO TO 116 00024900 IIJ = IIJ + 1 00025000 WRITE (IPR, 9025) TMORG(IIJ), VLORG(IIJ), DIPORG(IIJ) 00025100 C 00025200 C 00025300 C 00025400 C 00025500 116 IF(II .GE. IVP) GO TO 115 00025600 C 00025700 C 00025800 II = II + 1 00025900 ITM = DATTM(II) 00026000 IVR = DATVR(II) + .5 00026100 IVA = DATVA(II) + .5 00026200 IZ = DATZZ(II) + .5 00026300 C 00026400 WRITE (IPR, 9040) ITM, IVR, IVA, IZ 00026500 C 00026600 C 00026700 115 CONTINUE 00026800 IF ( I .EQ. 1 ) GO TO 180 00026900 C 00027000 C 00027100 C 00027200 CI IF(M .EQ. 2) GO TO 125 00027300 CI IF((I-1)*SAMPR.LE.DATTM (ILL)) GO TO 150 00027400 C 00027500 CI125 CONTINUE 00027600 C 00027700 CI IF (ILL .EQ. 1) GO TO 128 00027800 CI SUMVT = SUMVT + DATVI(ILL-1)*(DATTM(ILL)/1000. 00027900 CI * - (T-ASAMP)) + DATVI(ILL)*(T-DATTM(ILL)/1000.) 00028000 C 00028100 CI128 CONTINUE 00028200 CI IVI = DATVI(ILL) + .5 00028300 C 00028400 VI = (VRMS(I)*VRMS(I)*T - VRMS(IP)*VRMS(IP)*TP)/ASAMP 00028500 IF (VI .LT. 0.) VI = 0. 00028600 VI = SQRT ( VI ) 00028700 IVI = VI + 0.5 00028800 C 00028900 SUMVT = SUMVT + VI 00029000 VA = SUMVT/FLOAT(ILL) 00029100 C 00029200 LLAST = L 00029300 C 00029400 L = (VI - XMINV ) * SCALE + 1.5 00029500 ILL = ILL + 1 00029600 IF (L.LT.1) L = 1 00029700 IF(L.GT.98) L = 98 00029800 IF(L .GT. LLAST) GO TO 130 00029900 C 00030000 DO 120 00030100 * JJX = L,LLAST 00030200 C 00030300 120 LINE(JJX) = IIII 00030400 C 00030500 LLAST = L 00030600 GO TO 160 00030700 C 00030800 130 DO 140 00030900 * JJX = LLAST,L 00031000 C 00031100 140 LINE(JJX) = IIII 00031200 C 00031300 LLAST = L 00031400 GO TO 160 00031500 C 00031600 C 00031700 C 00031800 CI160 IF (ILL .GT. 2) GO TO 164 00031900 C 00032000 C COMPUTE THE AVERAGE VELOCITY 00032100 C 00032200 CI150 LINE(LLAST) = IIII 00032300 CI SUMVT = SUMVT + DATVI(ILL-1) * ASAMP 00032400 CI164 VA = SUMVT / T 00032500 C 00032600 160 K = ( VA - XMINV ) * SCALE + 1.5 00032700 IF (K .LT. 1) K = 1 00032800 IF (K .GT. 98) K = 98 00032900 IF(LINE(K) .NE. IIII) LINE(K) = AAAA 00033000 C 00033100 WRITE(IPR, 9050 ) IVI, LINE 00033200 C 00033300 IF (II .GT. IVPM1) GO TO 165 00033400 IF (M .LE. 4) GO TO 165 00033500 C 00033600 IVII = DATVI(II) + .5 00033700 WRITE (IPR, 9045) IVII 00033800 C 00033900 165 CONTINUE 00034000 C 00034100 DO 170 00034200 * K = 1, 98 00034300 C 00034400 170 LINE(K) = BLNK 00034500 C 00034600 LINE(1) = DOT 00034700 LINE(98) = DOT 00034800 C 00034900 180 K = ( VRMS(I) - XMINV) * SCALE + 1.5 00035000 IF (K.LT.1) K = 1 00035100 IF (K.GT.98) K = 98 00035200 LINE(K) = RRRR 00035300 C 00035400 IZ = INT(VA * T / 2.0 + .5) 00035501 X = DIST / VRMS(I) 00035600 XX = ( T*T + X*X ) 00035700 IF (XX.LT.0.) XX = 0. 00035800 DT = SQRT(XX) - T 00035900 IDT = DT * 1000. + .5 00036000 IT = T * 1000. + .5 00036100 IVA = VA + .5 00036200 IVR = VRMS(I) 00036300 C 00036400 WRITE(IPR, 9060 ) IT, IVR, IDT, IVA, IZ, LINE 00036500 C 00036600 IP = I 00036700 TP = T 00036800 C 00036900 190 CONTINUE 00037000 C 00037100 WRITE (IPR, 9005) MINV,MAXV 00037200 C 00037300 RETURN 00037400 C 00037500 9000 FORMAT( 1X,132('-'),/5X,'VELOCITY FUNCTION ID NUMBER ',I6,4X, 00037600 * 'X DISTANCE FOR DT = ',I8,4X,'DATUM ELEVATION = ',I8, 00037700 * 4X,'% INPUT VELOCITY = ',I8) 00037800 C 00037900 9005 FORMAT(1X, 132('-'),/1X,'TIME',4X,'VR',3X,'DT', 00038000 * 5X,'VA',4X,'VI',5X,'Z',' MINV=',I6, 00038100 * 75X,'MAXV=',I6,/1X,132(1H-),/) 00038200 C 00038300 9025 FORMAT ('+',79X,I5,I7,F5.1) 00038400 C 00038500 C 00038600 C 00038700 9020 FORMAT ('+',T80,1X,A4,' | ',A4,' | DIP| TIME | VR |', 00038800 * ' VA | VI | Z |') 00038900 9015 FORMAT ('+',T80,' ---- ORIGINAL ---|------------ CORR', 00039000 * 'ECTED -----------') 00039100 9010 FORMAT ('+',T97,'* CONTROL POINTS *') 00039200 C 00039300 9040 FORMAT ('+',96X,'|',I6,2I7,7X,I7) 00039400 C 00039500 9045 FORMAT ('+',96X,'|',20X,I7) 00039600 C 00039700 C 00039800 9050 FORMAT (1X,4X,11X,'|',6X,I6,6X,98A1) 00039900 C 00040000 9060 FORMAT (1X,I4,I6,I5,'|',I6,6X,I6,98A1) 00041000 END 00050000