C HEADER USCVVR 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CAINDMUSKVVR -- CONVERSION TO RMS VELOCITY FOR HZVA 00000203 CTITLE USKVVR -- CONVERSION TO RMS VELOCITY 00000302 CA AUTHOR J. MENDEKE 00000500 CA DESIGNER J. MENDEKE 00000600 CA LANGUAGE S/370 FORTRAN H EXTENDED 00000700 CA WRITTEN 06-04-79 00000800 C REVISED 11-19-79 MENDEKE - CHANGED IMAPI PRINT 00000900 C 03-22-82 PARKER - CHANGED NAME FROM USCVVR AND 00001000 C AND MODIFIED FOR HZVA. 00001100 C 03-31-82 PARKER - MODIFIED TO ACCEPT DECREMENTING 00001200 C DP NUMBERS. 00001300 C 05-11-82 PARKER - FIX INTERPOLATION BUG FOR STARTING00001400 C DP NO. OF 2. 00001500 C 12-29-83 PARKER - REMOVE REFERENCE TO NL AND 00001600 C OTHER EXTRANEOUS CODE. 00001700 CA 00001800 SUBROUTINE USKVVR 00001900 * (INPUT,NPTS,IDATA,IPR,ND,WRKA,T,VR,ERROR) 00002000 CA 00002100 CA CALL USKVVR(INPUT,NPTS,IDATA,IPR,ND,WRKA,T,VR,ERROR) 00002200 CA INPUT INPUT = ARRAY CONTAINING INPUT VELOCITY INFO I4 00002300 CA INPUT NPTS = NUMBER OF POINTS IN INPUT (NPTS/2 PAIRS) I4 00002400 CA INPUT IDATA = ORIGINAL INPUT DATA SAVED I4 00002500 CA INPUT IPR = INTERNAL PRINT UNIT I4 00002600 CA INPUT ND = NO. OF DEPTHPOINTS PER LINE I4 00002700 CA INPUT WRKA = WORK AREA R4 00002800 CA INPUT T = INTERPOLATED TIME GRID R4 00002900 CA INPUT VR = INTERPOLATED VELOCITY GRID R4 00003000 CA IN/OUT ERROR = RETURNED ERROR FLAG I4 00003100 CA 00003200 CA USKVVR COLLECTS VELOCITY INFORMATION AND CONVERTS TO RMS 00003300 CA VELOCITIES FOR USE BY USKVVG. 00003400 CA 00003500 CAEND 00003600 CTITLE USKVVI -- INITIALIZES USKVVR 00003700 CA AUTHOR J. MENDEKE 00003800 CA DESIGNER J. MENDEKE 00003900 CA LANGUAGE S/370 FORTRAN H EXTENDED 00004000 CA WRITTEN 06-04-79 00004100 C REVISED MO-DA-YR 00004200 C 03-22-82 BY CMP RENAMED FROM USCVVI FOR00004300 C USE IN HZVA 00004400 CA 00004500 CA 00004600 CA CALL USKVVI (NO ARGUMENTS) 00004700 CA 00004800 CA 00004900 CA INITIALIZES USKVVR. 00005000 CAEND 00005100 CTITLE USKVVG -- VELOCITY CONVERSION AND INTERPOLATION 00005200 CA AUTHOR J. MENDEKE 00005300 CA DESIGNER J. MENDEKE 00005400 CA LANGUAGE S/370 FORTRAN H EXTENDED 00005500 CA WRITTEN UNKNOWN 00005600 C REVISED 01-12-80 BY SAS - REPLACED CONTOUR 00005700 C VELOCITY-TIME INTERPOLATION 00005800 C WITH LINEAR INTERPLOATION 00005900 C FOR PROCESSING A SINGLE LINE. 00006000 C REVISED 03-22-82 BY CMP - RENAMED FROM USCVVG 00006100 C FOR USE IN HZVA 00006200 C REVISED 12-29-83 BY CMP - REMOVED REFERENCE TO 00006300 C IMAPI AND OTHER EXTRANEOUS CODE00006400 C 00006500 CA 00006600 CA CALL USKVVG 00006700 CA (KPNA,KPRNO,DENTRY,NOREC,IDATA,IPR,ND,WRKA,T,VR,ERROR) 00006800 CA 00006900 CA INPUT KPNA = PROCESS NAME A4 00007000 CA INPUT KPRNO = PROCESS NO. I4 00007100 CA INPUT DENTRY = PARAMETER ARRAY I4 00007200 CA INPUT NOREC = NO. OF PARAMETER RECORDS I4 00007300 CA INPUT IDATA = ORIGINAL INPUT DATA I4 00007400 CA INPUT IPR = INTERNAL PRINTER UNIT I4 00007500 CA INPUT ND = NUMBER OF DEPTHPOINTS I4 00007600 CA INPUT WRKA = WORK AREA R4 00007700 CA OUTPUT T = INTERPOLATED TIME GRID R4 00007800 CA OUTPUT VR = INTERPOLATED VELOCITY GRID R4 00007900 CA IN/OUT ERROR = RETURNED ERROR FLAG I4 00008000 CA 00008100 CA USKVVG COMPUTES THE TIMES AND VELOCITIES FOR A GIVEN 00008200 CA HORIZON FROM THE INFORMATION COLLECTED BY USKVVR. 00008300 CAEND 00008400 C 00008500 IMPLICIT INTEGER (A-Z) 00008600 EXTERNAL S1ATP 00008700 C INTEGER ARRAYS IN PARAMETER LIST 00008800 INTEGER INPUT (1) 00008900 INTEGER IDATA (1) 00009000 INTEGER DENTRY (1) 00009100 C REAL ARRAYS IN PARAMETER LIST 00009200 REAL T (ND) 00009300 REAL VR (ND) 00009400 REAL WRKA (ND,2) 00009500 C 00009600 C INTEGER ARRAYS - LOCAL 00009700 C 00009800 INTEGER INIT /1/ 00009900 INTEGER MOVE (4) 00010000 C 00010100 C 00010200 C REAL VARIABLES - LOCAL 00010300 C 00010400 REAL A 00010500 REAL B 00010600 REAL C 00010700 REAL UNDEF /-999999.9/ 00010800 C 00010900 C RETURN IF NO POINTS INPUT 00011000 C OR USKVVR IS NOT INITIALIZED. 00011100 C 00011200 IF ( INIT .NE. 0 ) GO TO 210 00011300 IF ( NPTS .EQ. 0 ) RETURN 00011400 C 00011500 C 00011600 DO 40 00011700 * I = 1, NPTS, 4 00011800 IF ( INPUT(I).EQ.0 .AND. INPUT(I+1).EQ.0 ) GO TO 40 00011900 IF ( IVP.GT.1 .AND. INPUT(I).LE.0 ) GO TO 240 00012000 IVP = IVP + 1 00012100 C 00012200 IDATA(IDP)=INPUT(I) 00012300 IDATA(IDP+1)=INPUT(I+1) 00012400 IDATA(IDP+2)=INPUT(I+2) 00012500 IDATA(IDP+3)=INPUT(I+3) 00012600 C 00012700 IDP = IDP + 4 00012800 C 00012900 40 CONTINUE 00013000 C 00013100 RETURN 110 00013200 C 00013300 C 00013400 C---------------------------------------------------------------------- 00013500 C 00013600 ENTRY USKVVI 00013700 C 00013800 CX USKVVI ENTRY -- INITIALIZATION 00013900 CX 00014000 C 00014100 INIT = 0 00014200 IVP = 0 00014300 IDP = 1 00014400 C 00014500 RETURN 00014600 C 00014700 C---------------------------------------------------------------------- 00014800 C 00014900 ENTRY USKVVG 00015000 *(KPNA,KPRNO,DENTRY,NOREC,IDATA,IPR,ND,WRKA,T,VR,ERROR) 00015100 C 00015200 IDP = IDP -1 00015300 C 00015400 C MAKE SURE THE DEPTH POINTS (SHOTPOINTS) ARE IN INCREASING ORDER 00015500 C 00015600 60 IF (IDATA(2) .LT. IDATA(6)) GO TO 90 00015700 C 00015800 J = IDP - 3 00015900 IDPH = J/2 00016000 C 00016100 C 00016200 DO 70 00016300 * I = 1, IDPH, 4 00016400 CALL ARMVE (IDATA(I), MOVE, 4) 00016500 CALL ARMVE (IDATA(J), IDATA(I), 4) 00016600 CALL ARMVE (MOVE , IDATA(J), 4) 00016700 J = J - 4 00016800 IF (I .GE. J) GO TO 80 00016900 70 CONTINUE 00017000 C 00017100 C 00017200 80 CONTINUE 00017300 C 00017400 C STORE DEFINED POINTS OF TIME 00017500 C 00017600 90 A = IDATA(3) 00017700 TSTZ = 0 00017800 C 00017900 C ONE LINE OF DATA -- LINEAR SETUP 00018000 C 00018100 J = 1 00018200 WRKA(1,1) = 1. 00018300 IF (IDATA(2) .EQ. 1) GO TO 100 00018400 C 00018500 C IF THE FIRST DP IS NOT 1, DEFINE A NEGATIVE VALUE AT DP 1 00018600 C 00018700 J = J + 1 00018800 TSTZ = 1 00018900 WRKA(1,2) = -1.5 00019000 WRKA(2,1) = IDATA(2) 00019100 IF (IDATA(2) .EQ. 2) GO TO 100 00019200 C 00019300 C IF THE NEXT DP IS NOT 2, DEFINE A NEGATIVE VALUE AT DP 2 00019400 C 00019500 WRKA(2,1) = IDATA(2) - 1 00019600 WRKA(2,2) = -1.5 00019700 WRKA(3,1) = IDATA(2) 00019800 J = J + 1 00019900 C 00020000 C PUT THE DP, TIME PAIRS IN AN ARRAY FOR INTERPOLATION 00020100 C 00020200 100 WRKA(J,2) = A 00020300 J = J + 1 00020400 C 00020500 DO 115 00020600 * I = 5, IDP, 4 00020700 IF (IDATA(I+2) .NE. A) TSTZ = 1 00020800 IF (IDATA(I) .EQ. IDATA(I-4)) GO TO 110 00020900 TSTZ = 1 00021000 WRKA(J,1) = WRKA(J-1,1) + 1 00021100 WRKA(J,2) =-1.5 00021200 J = J + 1 00021300 WRKA(J,1) = IDATA(I+1) - 1 00021400 WRKA(J,2) =-1.5 00021500 J = J + 1 00021600 110 WRKA(J,1) = IDATA(I+1) 00021700 WRKA(J,2) = IDATA(I+2) 00021800 J = J + 1 00021900 115 CONTINUE 00022000 C 00022100 C MAKE SURE THE TIME VALUES ARE NEGATIVE PAST THE LAST DEFINED 00022200 C POINT FOR THIS HORIZON 00022300 C 00022400 IF (IDATA(IDP-2) .EQ. ND) GO TO 130 00022500 TSTZ = 1 00022600 WRKA(J,1) = IDATA(IDP-2) + 1 00022700 WRKA(J,2) =-1.5 00022800 J = J + 1 00022900 WRKA(J,1) = ND 00023000 WRKA(J,2) =-1.5 00023100 J = J + 1 00023200 C 00023300 C INTERPOLATE MISSING GRID POINTS 00023400 C 00023500 130 B = J - .5 00023600 C 00023700 IF (TSTZ .NE. 0) CALL USINTP 00023800 * (WRKA(1,1),WRKA(1,2),B,1,1.,1.,ND,T) 00023900 C 00024000 IF (TSTZ .EQ. 0) CALL ARSET(T, ND, A) 00024100 C 00024200 C 00024300 C INTIALIZE WORK AREA FOR GRIDING VELOCITIES 00024400 C 00024500 DO 140 00024600 * I = 1, ND 00024700 C 00024800 DO 140 00024900 * J = 1, 2 00025000 C 00025100 WRKA(I,J) = UNDEF 00025200 C 00025300 140 CONTINUE 00025400 C 00025500 C STORE DEFINED POINTS OF VELOCITY 00025600 C 00025700 TSTZ = 0 00025800 A = IDATA(4) 00025900 C 00026000 C ONE LINE OF DATA -- LINEAR SETUP 00026100 C 00026200 J = 1 00026300 WRKA(1,1) = 1. 00026400 IF (IDATA(2) .EQ. 1) GO TO 145 00026500 C 00026600 C IF THE FIRST DP IS NOT 1 CODE A NEGATIVE VELOCITY VALUE 00026700 C 00026800 J = J + 1 00026900 TSTZ = 1 00027000 WRKA(1,2) =-1.5 00027100 WRKA(2,1) = IDATA(2) 00027200 IF (IDATA(2) .EQ. 2) GO TO 145 00027300 C 00027400 C IF THE NEXT DP IS NOT 2, CODE ANOTHER NEGATIVE VELOCITY VALUE 00027500 C 00027600 WRKA(2,1) = IDATA(2) - 1 00027700 WRKA(2,2) =-1.5 00027800 WRKA(3,1) = IDATA(2) 00027900 J = 3 00028000 C 00028100 C INPUT THE VELOCITY VALUES FOR LATER INTERPOLATION 00028200 C 00028300 145 WRKA(J,2) = A 00028400 J = J + 1 00028500 C 00028600 DO 155 00028700 * I = 5, IDP, 4 00028800 IF (IDATA(I+3) .NE. A) TSTZ = 1 00028900 IF (IDATA(I).EQ.IDATA(I-4)) GO TO 150 00029000 TSTZ = 1 00029100 WRKA(J,1) = WRKA(J-1,1) + 1 00029200 WRKA(J,2) =-1.5 00029300 J = J + 1 00029400 WRKA(J,1) = IDATA(I+1) - 1 00029500 WRKA(J,2) =-1.5 00029600 J = J + 1 00029700 150 WRKA(J,1) = IDATA(I+1) 00029800 WRKA(J,2) = IDATA(I+3) 00029900 J = J + 1 00030000 155 CONTINUE 00030100 C 00030200 C MAKE SURE THE VELOCITIES ARE NEGATIVE FOR DPS BEYOND THE LAST 00030300 C DEFINED DP FOR THIS HORIZON 00030400 C 00030500 IF (IDATA(IDP-2) .EQ. ND) GO TO 160 00030600 TSTZ = 1 00030700 WRKA(J,1) = IDATA(IDP-2) + 1 00030800 WRKA(J,2) =-1.5 00030900 J = J + 1 00031000 WRKA(J,1) = ND 00031100 WRKA(J,2) =-1.5 00031200 J = J + 1 00031300 C 00031400 C 00031500 160 B = J - .5 00031600 C 00031700 C INTERPOLATE MISSING GRID POINTS 00031800 C 00031900 IF (TSTZ .NE. 0) CALL USINTP 00032000 * (WRKA(1,1),WRKA(1,2),B,1,1.,1.,ND,VR) 00032100 C 00032200 IF (TSTZ .EQ. 0) CALL ARSET (VR, ND, A) 00032300 C 00032400 C 00032500 C STORE VELOCITIES ON THE SEISPARM FILE 00032600 C 00032700 C 00032800 DO 190 00032900 * I = 1, ND, 48 00033000 C 00033100 L = I + 48 -1 00033200 IF (L .GT. ND) L = ND 00033300 N = 9 00033400 C STORE TIME AND VELOCITY PAIRS 00033500 C 00033600 DO 180 00033700 * K = I, L 00033800 DENTRY(N) = T(K) + .5 00033900 DENTRY(N+1) = VR(K) + .5 00034000 N = N + 2 00034100 C 00034200 180 CONTINUE 00034300 C WRITE THE PARM RECORD 00034400 NOPAR = L - I + 1 00034500 DENTRY(6) = NOPAR*2 00034600 DA2 = NOREC + 1 00034700 CALL FOWP (KPNA, KPRNO, DA2, 104, DENTRY, &250 ) 00034800 NOREC = NOREC + 1 00034900 CALL ARSET(DENTRY(9),96,0) 00035000 C 00035100 190 CONTINUE 00035200 C 00035300 C 00035400 GO TO 270 00035500 C 00035600 210 WRITE(IPR, 9020 ) 00035700 GO TO 260 00035800 C 00035900 240 WRITE(IPR, 9040 ) (INPUT(I), I = 1, NPTS) 00036000 GO TO 260 00036100 C 00036200 250 WRITE(IPR, 9060 ) 00036300 GO TO 260 00036400 C 00036500 260 ERROR =-1 00036600 C 00036700 270 RETURN 00036800 C 00036900 C --- FORMAT STATEMENTS --- 00037000 C 00037100 C 00037200 9020 FORMAT (' *** USKVVR NOT INITIALIZED VIA USKVVI.') 00037300 C 00037400 9040 FORMAT (' *** VELOCITY FUNCTION CARD IN ERROR-- ',A4,1X, 00037500 * 14I5/20(46X,14I5/)) 00037600 C 00037700 9060 FORMAT (' *** FOWP HAD A WRITE ERROR ') 00037800 END 00037900