CTITLESAALAG -- ADJUST LAG VALUES FOR TR3D 00010006 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D.D. REED 00020006 CA DESIGNER D.D. REED 00030006 CA LANGUAGE VS FORTRAN 00040006 CA SYSTEM IBM 00050006 CA WRITTEN 2/18/76 00060006 C REVISED 10-31-79 H JULIAN - ADAPTED FOR 3D TRAC. 00070006 C REVISED 03-02-80 R DECKER - ELIMINATED WEIGHT AND ERR ARRAYS 00080006 C ADDED CDPP AND KCDP ARRAYS. 00090006 C REVISED 01-15-85 REP - ADD USBFRX CALLS. 00100006 C REVISED 08-14-85 REP - CHANGE NAME FROM SAERR3 00110006 C REVISED 11-09-88 ESN - INCORPORATE MEMORY PATH. 00120006 C REVISED 01-14-91 ESN - CREATED FROM SAERRX. 00130006 CA 00140006 CA CALL SAALAG (X, XCDP, XRNMO, IND, OFF, CDPP, KCDP, Y, YPE, DIF1, 00150006 CA ITCNT, NOITER, LD, LINE, NLINE, KPBUGF, IPRT, NOALAG,00160006 CA Q) 00170006 CA 00180006 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00190006 CA 00200006 CA IN X R8 COMPONENTS OF PREDICTED VALUES 00210006 CA IN XCDP R8 NEGATIVE OF THE PILOT STATIC 00220006 CA IN XRNMO R8 RNMO FOR EACH CDP AT OFFSET = 1 00230006 CA IN IND I4 INDEX ARRAY (-> X FOR PREDICTED VALUES) 00240006 CA IN OFF R4 SQUARED NORMALIZED OFFSET DISTANCES 00250006 CA IN CDPP I4 POINTER TO THE END OF EACH CDP 00260006 CA IN KCDP I4 STARTING CDP FOR EACH LINE 00270006 CA IN Y R4 OBSERVED VALUES 00280006 CA IN YPE R4 OBSERVED PERIODICITY 00290006 CA IN DIF1 I4 CDP BIAS TO CONVERT IND VALUES. 00300006 CA IN ITCNT I4 ITERATON COUNTER, 1 = LAST ITERATION 00310006 CA IN NOITER I4 NUMBER OF ITERATIONS TO BE PERFORMED 00320006 CA IN LD I4 NUMBER OF DEPTH POINTS 00330006 CA IN LINE I4 ARRAY OF LINE END POINTERS 00340006 CA IN NLINE I4 NUMBER OF LINES 00350006 CA IN KPBUGF I4 DEBUG FLAG 00360006 CA IN IPRT I4 PRINTER UNIT FOR OUTPUT 00370006 CA IN NOALAG I4 NUMBER OF ALTERED LAG VALUES 00380006 CA OUT Q R8 ARRAY OF MEASURED LAGS FOR EACH TRACE. 00390006 CA 00400006 CA 00410006 CA SAALAG MODIFIES THE LAG VALUES FOR TRACES WITH ERRORS GREATER 00420006 CA THAN HALF THE PERIOD. 00430006 CA 00440006 C 00450006 SUBROUTINE SAALAG (X, XCDP, XRNMO, IND, OFF, CDPP, KCDP, Y, YPE, 00460006 * DIF1, ITCNT, NOITER, LD, LINE, NLINE, KPBUGF, IPRT, 00470006 * NOALAG) 00480006 C 00490006 COMMON COM (1) 00500006 INTEGER COM 00510006 REAL XCOM (1) 00520006 REAL*8 ZCOM (1) 00530006 EQUIVALENCE (COM(1),XCOM(1),ZCOM(1)) 00540006 C 00550006 C COMMON BUFFERING INFORMATION BLOCK 00560006 C 00570006 COMMON /BFINFO/ BYND(15), BIND(15), BOFF(15), BQND(15), BYPE(15) 00580006 C 00590006 INTEGER BYND, BIND, BOFF, BQND, BYPE 00600006 C 00610006 C 00620006 C REAL ARRAYS IN PARAMETER LIST 00630006 C 00640006 REAL*8 X (1) 00650006 REAL*8 XCDP (1) 00660006 REAL*8 XRNMO (1) 00670006 REAL OFF (1) 00680006 REAL Y (1) 00690006 REAL YPE (1) 00700006 REAL HIST (1000) 00710006 REAL HISTWR (1000) 00720006 C 00730006 C INTEGER ARRAYS IN PARAMETER LIST 00740006 C 00750006 INTEGER CDPP (1) 00760006 INTEGER IND (2,1) 00770006 INTEGER KCDP (1) 00780006 INTEGER LINE (1) 00790006 C 00800006 C INTEGER ARRAY -- LOCAL 00810006 C 00820006 INTEGER INDORG (3) 00830006 C 00840006 C INTEGER VARIABLE -- LOCAL 00850006 C 00860006 INTEGER DIF1 00870006 INTEGER B1 00880006 INTEGER B2 00890006 INTEGER B3 00900006 INTEGER B4 00910006 C 00920006 NOALAG = 0 00930006 HISTST = -200.0 00940008 HISTEN = 200.0 00950008 HISTIN = 5.0 00960009 MXHIST = 80 00970009 CALL ARSET (HIST,MXHIST,0.0) 00980006 N = NOITER - ITCNT + 1 00990006 WRITE (IPRT, 9040) N 01000006 C 01010006 C INITIALIZE 01020006 C 01030006 KK = 0 01040006 SUM = 0.0 01050006 SUM2 = 0.0 01060006 C 01070006 C PRINT LINES OF PREDICTED VS OBSERVED VALUES AND ERROR 01080006 C 01090006 NT = 0 01100006 IA = 1 01110006 KP = 1 01120006 C 01130006 DO 40 II = 1, NLINE 01140006 IB = LINE(II) 01150006 KKCDP = KCDP(II) 01160006 C 01170006 IF (BYND(12) .EQ. 0) THEN 01180006 CALL XDUMPX 01190006 ELSE 01200006 B1 = 1 01210006 B2 = 1 01220006 B3 = 1 01230006 B4 = (BQND(12)+1) / 2 01240006 DO 130 I1 = IA, IB 01250006 IND(1,B1) = COM(BIND(12)+2*I1-2) 01260006 IND(2,B1) = COM(BIND(12)+2*I1-1) 01270006 OFF(B2) = XCOM(BOFF(12)+I1-1) 01280006 Y(B3) = XCOM(BYND(12)+I1-1) 01290006 YPE(B3) = XCOM(BYPE(12)+I1-1) 01300006 PRED = XCDP((II-1)*LD+KKCDP) + X(IND(1,B1)) + X(IND(2,B1)) 01310006 PRED2 = PRED + XRNMO((II-1) * LD + KKCDP) * OFF(B2) 01320006 ER = Y(B3) - PRED 01330006 ER2 = Y(B3) - PRED2 01340006 C 01350006 IF (Y(B3) .GT. 1000000.) GO TO 120 01360006 NT = NT + 1 01370006 C 01380006 I = (ER2-HISTST) / HISTIN + 1.0 01390010 IF (I .LT. 1) I = 1 01400009 IF (I .GT. MXHIST) I = MXHIST 01410009 HIST(I) = HIST(I) + 1.0 01420009 C 01430009 IF (YPE(B3) .LE. 0.0) GO TO 120 01440009 C 01450009 IF (ABS(ER2) .GT. YPE(B3)*0.5) THEN 01460006 IF (ER2 .GE. 0.0) THEN 01470006 Y(B3) = Y(B3) - YPE(B3) 01480006 ELSE 01490006 Y(B3) = Y(B3) + YPE(B3) 01500006 ENDIF 01510006 XCOM(BYND(12)+I1-1) = Y(B3) 01520006 NOALAG = NOALAG + 1 01530006 ENDIF 01540006 C 01550006 120 CONTINUE 01560007 ZCOM(B4+I1-1) = Y(B3) 01570007 IF(I1 .LT. CDPP(KP)) GO TO 130 01580007 KP = KP + 1 01590006 KKCDP = KKCDP + 1 01600006 C 01610006 130 CONTINUE 01620006 ENDIF 01630006 IA = IB + 1 01640006 40 CONTINUE 01650006 C 01660006 C COMPUTE AND PRINT INFORMATION 01670006 C 01680006 PCENT = 100.0*NOALAG / FLOAT(NT) 01690006 WRITE (IPRT, 9020) NOALAG, NT, PCENT 01700006 C 01710006 CALL USHIST (HIST, MXHIST, HISTST, HISTEN, HISTIN, HISTWR, IPRT) 01720006 C 01730006 RETURN 01740006 C 01750006 C FORMATS 01760006 C 01770006 9020 FORMAT(/// ' NUMBER OF ADJUSTED LAGS = ', I8,/, 01780006 * ' NUMBER OF POSSIBILITIES = ', I8,/, 01790006 * ' PERCENT OF ADJUSTMENTS = ', F8.2) 01800006 C 01810006 9040 FORMAT(/// ' RESULTS OF ADJUSTING LAGS ITERATION NUMBER ', I2, 01820006 * / ' ======= == ========= ==== ========= ====== ==') 01830006 C 01840006 END 01850006