CTITLESAERRY -- PERFORM ERROR CALCULATIONS FOR TRAC 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D.D. REED 00020000 CA DESIGNER D.D. REED 00030000 CA LANGUAGE VS FORTRAN 00040000 CA SYSTEM IBM 00050000 CA WRITTEN 2/18/76 00060000 C REVISED 10-31-79 H JULIAN - ADAPTED FOR 3D TRAC. 00070000 C REVISED 03-02-80 R DECKER - ELIMINATED WEIGHT AND ERR ARRAYS 00080000 C ADDED CDPP AND KCDP ARRAYS. 00090000 C REVISED 01-15-85 REP - ADD USBFRX CALLS. 00100000 C REVISED 08-14-85 REP - CHANGE NAME FROM SAERR3 00110000 C REVISED 11-09-88 ESN - INCORPORATE MEMORY PATH. 00120000 C REVISED 02-09-91 ESN - CREATED FROM SAERRX TO ADD IN PRINT 00130000 C OF SHOT AND RECEIVER ERRORS. 00140000 CA 00150000 CA CALL SAERRY (X, XCDP, XRNMO, IND, OFF, CDPP, KCDP, Y, DIF1, 00160000 CA ITCNT, NOITER, LD, LINE, NLINE, KPBUGF, IPRT, 00170000 CA WR, WS, LR, LS) 00180000 CA 00190000 CA IN/OUT ARGUMENT TYPE DESCRIPTION 00200000 CA 00210000 CA IN X R8 COMPONENTS OF PREDICTED VALUES 00220000 CA IN XCDP R8 NEGATIVE OF THE PILOT STATIC 00230000 CA IN XRNMO R8 RNMO FOR EACH CDP AT OFFSET = 1 00240000 CA IN IND I4 INDEX ARRAY (-> X FOR PREDICTED VALUES) 00250000 CA IN OFF R4 SQUARED NORMALIZED OFFSET DISTANCES 00260000 CA IN CDPP I4 POINTER TO THE END OF EACH CDP 00270000 CA IN KCDP I4 STARTING CDP FOR EACH LINE 00280000 CA IN Y R4 OBSERVED VALUES 00290000 CA IN DIF1 I4 CDP BIAS TO CONVERT IND VALUES. 00300000 CA IN ITCNT I4 ITERATON COUNTER, 1 = LAST ITERATION 00310000 CA IN NOITER I4 NUMBER OF ITERATIONS TO BE PERFORMED 00320000 CA IN LD I4 NUMBER OF DEPTH POINTS 00330000 CA IN LINE I4 ARRAY OF LINE END POINTERS 00340000 CA IN NLINE I4 NUMBER OF LINES 00350000 CA IN KPBUGF I4 DEBUG FLAG 00360000 CA IN IPRT I4 PRINTER UNIT FOR OUTPUT 00370000 CA IN WR R4 RECEIVER WEIGHTING 00380000 CA IN WS R4 SHOT WEIGHTING 00390000 CA IN LR I4 LENGTH OF RECEIVER ARRAY 00400000 CA IN LS I4 LENGTH OF SHOT ARRAY 00410000 CA 00420000 CA 00430000 CA SAERRY PRINTS A TABLE OF PREDICTED (A SUM OF 3 X VALUES FOUND 00440000 CA BY THE INDICES IN THE IND ARRAY) VS THE OBSERVED VALUES (Y) 00450000 CA AND THE ERROR (OBSERVED - PREDICTED) FOR EACH. THE RMS ERROR 00460000 CA IS ALSO COMPUTED AND PRINTED. 00470000 CA 00480000 C 00490000 SUBROUTINE SAERRY (X, XCDP, XRNMO, IND, OFF, CDPP, KCDP, Y, 00500000 * DIF1, ITCNT, NOITER, LD, LINE, NLINE, KPBUGF, IPRT, 00510000 * WR, WS, LR, LS) 00520000 C 00530000 COMMON COM (1) 00540000 INTEGER COM 00550000 REAL XCOM (1) 00560000 REAL*8 ZCOM (1) 00570000 EQUIVALENCE (COM(1),XCOM(1),ZCOM(1)) 00580000 C 00590000 C COMMON BUFFERING INFORMATION BLOCK 00600000 C 00610000 COMMON /BFINFO/ BYND(15), BIND(15), BOFF(15), BQND(15) 00620000 C 00630000 INTEGER BYND, BIND, BOFF, BQND 00640000 C 00650000 C 00660000 C REAL ARRAYS IN PARAMETER LIST 00670000 C 00680000 REAL*8 X (1) 00690000 REAL*8 XCDP (1) 00700000 REAL*8 XRNMO (1) 00710000 REAL OFF (1) 00720000 REAL Y (1) 00730000 C 00740000 C INTEGER ARRAYS IN PARAMETER LIST 00750000 C 00760000 INTEGER CDPP (1) 00770000 INTEGER IND (2,1) 00780000 INTEGER KCDP (1) 00790000 INTEGER LINE (1) 00800000 C 00810000 C INTEGER ARRAY -- LOCAL 00820000 C 00830000 INTEGER INDORG (3) 00840000 C 00850000 C INTEGER VARIABLE -- LOCAL 00860000 C 00870000 INTEGER DIF1 00880000 INTEGER B1 00890000 INTEGER B2 00900000 INTEGER B3 00910000 C 00920000 N = NOITER - ITCNT + 1 00930000 WRITE (IPRT, 9040) N 00940000 IF (KPBUGF .GT. 1 .AND. ITCNT .EQ. 1) WRITE (IPRT, 9000) 00950000 C 00960000 C INITIALIZE 00970000 C 00980000 KK = 0 00990000 SUM = 0.0 01000000 SUM2 = 0.0 01010000 C 01020000 C PRINT LINES OF PREDICTED VS OBSERVED VALUES AND ERROR 01030000 C 01040000 NT = 0 01050000 IA = 1 01060000 KP = 1 01070000 C 01080000 DO 40 II = 1, NLINE 01090000 IB = LINE(II) 01100000 KKCDP = KCDP(II) 01110000 C 01120000 IF (BYND(12) .EQ. 0) THEN 01130000 DO 30 I1 = IA, IB 01140000 CALL USBFRX (IND, I1, B1, 0, BIND) 01150000 CALL USBFRX (OFF, I1, B2, 0, BOFF) 01160000 CALL USBFRX (Y , I1, B3, 0, BYND) 01170000 PRED = XCDP((II-1)*LD+KKCDP) + X(IND(1,B1)) + X(IND(2,B1)) 01180000 PRED2 = PRED + XRNMO((II-1) * LD + KKCDP) * OFF(B2) 01190000 ER = Y(B3) - PRED 01200000 ER2 = Y(B3) - PRED2 01210000 C 01220000 INDORG(1) = KKCDP - DIF1 01230000 INDORG(2) = IND(1,B1) 01240000 INDORG(3) = IND(2,B1) 01250000 IF (ITCNT .GT. 1) GO TO 10 01260000 IF (KPBUGF .GT. 1) WRITE (IPRT, 9010) 01270000 * (INDORG(K), K = 1, 3), Y(B3), PRED, ER, PRED2, ER2 01280000 C 01290000 10 IF (Y(B3) .GT. 1000000.) GO TO 20 01300000 SUM = SUM + ER * ER 01310000 SUM2 = SUM2 + ER2 * ER2 01320000 NT = NT + 1 01330000 C 01340000 20 IF(I1 .LT. CDPP(KP)) GO TO 30 01350000 KP = KP + 1 01360000 KKCDP = KKCDP + 1 01370000 C 01380000 30 CONTINUE 01390000 ELSE 01400000 B1 = 1 01410000 B2 = 1 01420000 B3 = 1 01430000 DO 130 I1 = IA, IB 01440000 IND(1,B1) = COM(BIND(12)+2*I1-2) 01450000 IND(2,B1) = COM(BIND(12)+2*I1-1) 01460000 OFF(B2) = XCOM(BOFF(12)+I1-1) 01470000 Y(B3) = XCOM(BYND(12)+I1-1) 01480000 PRED = XCDP((II-1)*LD+KKCDP) + X(IND(1,B1)) + X(IND(2,B1)) 01490000 PRED2 = PRED + XRNMO((II-1) * LD + KKCDP) * OFF(B2) 01500000 ER = Y(B3) - PRED 01510000 ER2 = Y(B3) - PRED2 01520000 C 01530000 INDORG(1) = KKCDP - DIF1 01540000 INDORG(2) = IND(1,B1) 01550000 INDORG(3) = IND(2,B1) 01560000 IF (ITCNT .GT. 1) GO TO 110 01570000 IF (KPBUGF .GT. 1) WRITE (IPRT, 9010) 01580000 * (INDORG(K), K = 1, 3), Y(B3), PRED, ER, PRED2, ER2 01590000 C 01600000 110 IF (Y(B3) .GT. 1000000.) GO TO 120 01610000 SUM = SUM + ER * ER 01620000 SUM2 = SUM2 + ER2 * ER2 01630000 NT = NT + 1 01640000 C 01650000 120 IF(I1 .LT. CDPP(KP)) GO TO 130 01660000 KP = KP + 1 01670000 KKCDP = KKCDP + 1 01680000 C 01690000 130 CONTINUE 01700000 ENDIF 01710000 IA = IB + 1 01720000 40 CONTINUE 01730000 C 01740000 C COMPUTE AND PRINT RMS ERROR 01750000 C 01760000 RMS = SQRT (SUM / FLOAT(NT)) 01770000 RMS2 = SQRT (SUM2 / FLOAT(NT)) 01780000 WRITE (IPRT, 9020) RMS 01790000 WRITE (IPRT, 9030) RMS2 01800000 C 01810000 C COMPUTE AND PRINT SHOT AND RECEIVER RMS ERROR 01820000 C 01830000 IF (BYND(12) .EQ. 0) THEN 01840000 CALL XDUMPX 01850000 ELSE 01860000 SUM3 = 0.0 01870000 DO 510 I = 1, LR 01880000 SUM3 = SUM3 + X(I)*X(I) 01890000 510 CONTINUE 01900000 SUM4 = 0.0 01910000 DO 520 I = LR+1, LS 01920000 SUM4 = SUM4 + X(I)*X(I) 01930000 520 CONTINUE 01940000 ENDIF 01950000 C 01960000 RMS3 = SQRT (SUM3 / FLOAT(LR)) 01970000 RMS4 = SQRT (SUM4 / FLOAT(LS-LR)) 01980000 RMS5 = SQRT ((SUM2+WR*WR*SUM3+WS*WS*SUM4) / 01990000 * (NT+WR*WR*LR+WS*WS*(LS-LR))) 02000000 WRITE (IPRT, 9200) RMS3, RMS4, RMS5 02010000 C 02020000 RETURN 02030000 C 02040000 C FORMATS 02050000 C 02060000 9000 FORMAT(' ORIG.',6X,'REN.',6X,'REN.',24X,'PRED.',13X,'ERROR',11X, 02070000 1 'PRED.',12X,'ERROR', 02080000 2 /' DEPTH',6X,'REC.',6X,'SHOT',6X,'OBS.',10X,'(NO RNMO)',9X, 02090000 3 '(NO RNMO)',10X,'(RNMO)',11X,'(RNMO)') 02100000 C 02110000 9010 FORMAT (1H ,I5, 2X, 2(I8,2X),5(E14.7,3X)) 02120000 C 02130000 9020 FORMAT(/// ' RMS ERROR IN SATISFYING SURFACE CONSISTANT ', 02140000 * 'EQUATIONS = ', F12.7, ' MS.') 02150000 C 02160000 9030 FORMAT(/ ' RMS ERROR IN SATISFYING SURFACE CONSISTANT ', 02170000 * 'EQUATIONS (INCLUDING RNMO SOLUTION) = ',F12.7,' MS.') 02180000 C 02190000 9040 FORMAT(/// ' RESULTS OF ITERATION NUMBER ', I2, 02200000 * / ' ======= == ========= ====== ==') 02210000 C 02220000 9200 FORMAT(/ ' SURFACE CONSISTANT ', 02230000 * 'EQUATIONS (INCLUDING RNMO SOLUTION):',/, 02240000 * ' RECEIVER TERM = ',F12.7,' MS.',/, 02250000 * ' SHOT TERM = ',F12.7,' MS.',/, 02260000 * ' TOTAL RMS ERROR = ',F12.7,' MS.') 02270000 C 02280000 END 02290000