CTITLESAERRK -- PERFORM ERROR CALCULATIONS FOR TRAK 00000010 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR D.D. REED 00000020 CA DESIGNER D.D. REED 00000030 CA LANGUAGE VS FORTRAN 00000040 CA SYSTEM IBM OR CRAY 00000041 CA WRITTEN 2/18/76 00000050 C REVISED R.PROBST 6/26/79 ADD CALLS TO USBUFR 00000060 C REVISED D. POLAK 5/22/80 ADDED CHECK FOR DECREASING RMS 00000070 C ERROR BETWEEN MAJOR ITERATIONS. 00000080 C REVISED D. POLAK 1/15/81 ADDED OPTION TO PRINT RMS ERROR 00000090 C AS MS. OR DB. 00000100 C REVISED M. PONTON 4/29/86 DUAL IBM/CRAY VERSION. 00000101 C REVISED R. KNIGHT11/01/88 PASS NNITER SO ITERATIONS CAN 00000102 C CONTINUE AS LONG AS RMS ERROR 00000103 C DECREASES (UP TO MAX OF NOITER) 00000104 C REVISED 09-20-90 CLJ ADDED CHECK TO PREVENT DIVIDE BY ZERO C WHEN ALL THE TRACE WEIGHTS ARE ZERO CA 00000110 CA 00000120 CA CALL SAERRK (X, IND, OFF, WT, NLT, LS, Y, ERR, DIF1, ITCNT, 00000130 CA NNITER, NOITER, KPBUGF, IPRT, BUFV, IUNIT) 00000140 CA 00000150 CA INPUT X = COMPONENTS OF PREDICTED VALUES R8 00000160 CA IND = INDEX ARRAY (-> X FOR PRED. VALUES) I4 00000170 CA OFF = SQUARED NORMALIZED OFFSET DISTANCES R4 00000180 CA WT = TRACE WEIGHTS R4 00000190 CA LS = LAST SHOT SOLUTION INDEX I4 00000200 CA Y = OBSERVED VALUES R4 00000210 CA ERR = ERRORS FOR EACH TRACE - REJECTS = 0 R4 00000220 CA DIF1 = CDP BIAS TO CONVER IND VALUES. I4 00000230 CA ITCNT = ITERATION COUNTER, 1 = LAST ITERATION I4 00000240 CA NNITER = NUMBER OF ITERATIONS (SIGNED) I4 00000250 CA NOITER = NUMBER OF ITERATIONS (ABS VAL) I4 00000251 CA NLT = NUMBER OF TRACES (Y VALUES) I4 00000260 CA KPBUGF = DEBUG FLAG I4 00000270 CA IPRT = PRINTER UNIT FOR OUTPUT I4 00000280 CA BUFV = USBUFR VARIABLE ARRAY I4 00000290 CA IUNIT = UNITS OF OBSERVED VALUES : 1 = MS. I4 00000300 CA 2 = DB. 00000310 CA 00000320 CA 00000330 CA SAERRK PRINTS A TABLE OF PREDICTED (A SUM OF 3 X VALUES FOUND 00000340 CA BY THE INDICES IN THE IND ARRAY) VS THE OBSERVED VALUES (Y) 00000350 CA AND THE ERROR (OBSERVED - PREDICTED) FOR EACH. THE RMS ERROR 00000360 CA IS ALSO COMPUTED AND PRINTED. 00000370 CAEND 00000380 C 00000390 SUBROUTINE SAERRK (X, IND, OFF, WT, NLT, LS, Y, ERR, DIF1, ITCNT, 00000400 * NNITER, NOITER, KPBUGF, IPRT, BUFV, IUNIT) 00000410 C 00000420 C 00000430 C REAL ARRAYS 00000440 C 00000450 C 00000460 DOUBLE PRECISION X(1) 00000470 REAL ERR(1) 00000480 REAL Y(1) 00000490 REAL OFF(1) 00000500 REAL WT(1) 00000510 C 00000520 C INTEGER ARRAYS 00000530 C 00000540 INTEGER INDORG (3) 00000550 INTEGER IND(1), BUFV(4) 00000560 C 00000570 C INTEGER VARIABLES 00000580 C 00000590 INTEGER DA 00000600 INTEGER DIF1 00000610 C 00000620 N = NOITER - ITCNT + 1 00000630 WRITE (IPRT, 1005) N 00000640 IF (KPBUGF .GT. 1 .AND. ITCNT .EQ. 1) WRITE (IPRT,1001) 00000650 C 00000660 C INITIALIZE 00000670 C 00000680 KK=0 00000690 SUM=0.0 00000700 SUM2=0.0 00000710 RMS = 0.0 RMS2 = 0.0 C 00000720 C PRINT LINES OF PREDICTED VS OBSERVED VALUES 00000730 C AND ERROR 00000740 C 00000750 DA = 1 00000760 I1 = 1 00000770 CALL USBUFR (0, IND, BUFV, DA, I1) 00000780 NT = 0 00000790 DO 11 00000800 * I2 = 1, NLT 00000810 PRED=X(IND(I1))+X(IND(I1+1))+X(IND(I1+2)) 00000820 PRED2=PRED+X(LS+IND(I1))*OFF(I1) 00000830 ER= Y(I1)-PRED 00000840 ER2=Y(I1)-PRED2 00000850 ERR(I1) = ER2 00000860 IF (WT(I1) .EQ. 0) ERR(I1) = 0.0 00000870 C 00000880 INDORG(1) = IND(I1) - DIF1 00000890 INDORG(2) = IND(I1+1) 00000900 INDORG(3) = IND(I1+2) 00000910 IF (ITCNT .GT. 1) GO TO 5 00000920 IF (KPBUGF .GT. 1) 00000930 * WRITE (IPRT,1002) (INDORG(K),K=1,3),Y(I1),PRED,ER,PRED2,ER2 00000940 C 00000950 5 CONTINUE 00000951 IF (WT(I1) .EQ. 0.0) GO TO 10 00000960 SUM = SUM + ER**2 00000970 SUM2 = SUM2 + ER2**2 00000980 NT = NT + 1 00000990 10 CONTINUE 00001000 CALL USBUFR (2, IND, BUFV, DA, I1) 00001010 11 CONTINUE 00001020 CALL USBUFR (-2, IND, BUFV, DA, I1) 00001030 C 00001040 C COMPUTE(IF # WEIGHTS > 0)AND PRINT RMS ERROR 00001050 C 00001060 IF(NT .GT. 0) THEN RMS= SQRT (SUM/FLOAT(NT)) RMS2 = SQRT (SUM2/FLOAT(NT)) END IF C IF (IUNIT .EQ. 1) WRITE (IPRT, 1003) RMS 00001090 IF (IUNIT .EQ. 1) WRITE (IPRT, 1004) RMS2 00001100 IF (IUNIT .EQ. 2) WRITE (IPRT, 1008) RMS 00001110 IF (IUNIT .EQ. 2) WRITE (IPRT, 1009) RMS2 00001120 C 00001130 C STOP ITERATIONS IF THE RMS ERROR HAS INCREASED 00001140 C 00001150 IF (ITCNT .EQ. NOITER) GO TO 50 00001160 TEST = RMS2SV - 0.1 00001170 IF (RMS2 .LE. TEST) GO TO 50 00001180 IF (NNITER.GT.0) THEN 00001181 ITCNT = 1 00001190 IF (N.NE.NOITER .AND. RMS2.LE.RMS2SV) WRITE(IPRT,1006) N 00001200 ENDIF 00001201 IF (RMS2 .GT. RMS2SV) ITCNT = 1 00001210 IF (RMS2 .GT. RMS2SV) NOITER = -1 00001211 IF (RMS2 .GT. RMS2SV) WRITE (IPRT, 1007) N 00001220 50 RMS2SV = RMS2 00001230 C 00001240 RETURN 00001250 C 00001260 C FORMATS 00001270 C 00001280 1001 FORMAT(' ORIG.',6X,'REN.',6X,'REN.',24X,'PRED.',13X,'ERROR',11X, 00001290 1 'PRED.',12X,'ERROR', 00001300 2 /' DEPTH',6X,'REC.',6X,'SHOT',6X,'OBS.',10X,'(NO RNMO)',9X, 00001310 3 '(NO RNMO)',10X,'(RNMO)',11X,'(RNMO)') 00001320 C 00001330 1002 FORMAT (1H ,I5, 2X, 2(I8,2X),5(E14.7,3X)) 00001340 C 00001350 1003 FORMAT(/// ' RMS ERROR IN SATISFYING SURFACE CONSISTENT ', 00001360 * 'EQUATIONS = ', F12.7, ' MS.') 00001370 C 00001380 1004 FORMAT(/ ' RMS ERROR IN SATISFYING SURFACE CONSISTENT ', 00001390 * 'EQUATIONS (INCLUDING RNMO SOLUTION) = ',F12.7,' MS.') 00001400 C 00001410 1005 FORMAT(/// ' RESULTS OF ITERATION NUMBER ', I2, 00001420 * / ' ======= == ========= ====== ==') 00001430 C 00001440 1006 FORMAT(//5X,' ***ITERATIONS STOPPED AFTER ',I2,' ITERATIONS DUE ',00001450 * 'TO AN INSIGNIFICANT IMPROVEMENT IN THE RMS ERROR (INCLUD',00001460 * 'ING RNMO).') 00001470 C 00001480 1007 FORMAT(//5X,' ***ITERATIONS STOPPED AND SOLUTION FROM ITERATION ',00001490 * I2,' NOT APPLIED DUE TO INCREASE IN RMS ERROR (INCLUDING ',00001500 * 'RNMO).') 00001510 C 00001520 1008 FORMAT (/// ' RMS ERROR IN SATISFYING SURFACE CONSISTENT ', 00001530 * 'EQUATIONS = ', F12.7, ' DB.') 00001540 C 00001550 1009 FORMAT (/ ' RMS ERROR IN SATISFYING SURFACE CONSISTENT ', 00001560 * 'EQUATIONS (INCLUDING OFFSET SOLUTION) = ',F12.7,' DB.')00001570 C 00001580 END 00001590