FUNCTION SGEOLS G (AB , DAT , NS ) C C *************************************************************** C * UNCLASSIFIED * C *************************************************************** C C CALLING SEQUENCE C FUNCTION SGEOLS C G (AB , DAT , NS ) C C AUTHOR C OLIVER D. SMITH (EG&G WASC) C DEKKER-BRENT IMPLEMENTATION BY C JAMES S. VANDERGRAFT (COMPUTATIONAL ENGINEERING, INC) C DEKKER-BRENT CODE STRUCTURING BY C PAUL J. KRAUS & CINDY A. WELLS (COMPUTATIONAL ENGINEERING, INC) C CODE READ BY C WILLIAM H. FARR (B10, NSWCDD) & OLIVER D. SMITH (EG&G WASC) C PURPOSE C TO CALCULATE THE VALUE OF THE FUNCTION FOR THE GEOMETRIC MODEL C (REF: NSWCDD TR 82-171) USING THE LEAST SQUARES ESTIMATION C METHOD. C DESCRIPTION C THIS ROUTINE CALCULATES THE VALUE OF THE FUNCTION AT THE POINT C AB (ESTIMATE OF THE PROPORTIONALITY CONSTANT). C ASSUMPTIONS C (NONE) C RESTRICTIONS C (NONE) C PARAMETER GLOSSARY C (NONE) C GLOBAL GLOSSARY C (NONE) C ARGUMENT LIST C GIVEN C AB (R) = ESTIMATE OF PROPORTIONALITY CONSTANT C DAT (R) = TBF VECTOR (WC OR CPU) C NS (I) = SIZE OF DAT C YIELDED C SGEOLS (R) = FUNCTION VALUE AT POINT AB C LOCAL GLOSSARY C SM1 (R) = TEMPORARY SUMMATION 1 C SM2 (R) = TEMPORARY SUMMATION 2 C SM3 (R) = TEMPORARY SUMMATION 3 C SM4 (R) = TEMPORARY SUMMATION 4 C TMP (R) = INTERMEDIATE CALCULATION C ERRORS C (NONE) C ASSOCIATED SUBPROGRAMS C SEE AUTOMATED CODE EXAMINER (ACE) OUTPUT C REFERENCES C SEE PROLOGUE OF MAIN PROGRAM C LANGUAGE C FORTRAN 77 C C *********************** START OF DECLARATIONS ************************ C C PRE-DECLARATION DEFAULT ASSIGNMENT IMPLICIT DOUBLE PRECISION (A-Z) C C PARAMETER SPECIFICATIONS C (NONE) C C GLOBAL SPECIFICATIONS C (NONE) C C ARGUMENT SPECIFICATIONS INTEGER NS DIMENSION DAT(NS) C C LOCAL SPECIFICATIONS INTEGER I C C ********************* START OF FORMAT STATEMENTS ********************* C C (NONE) C C ********************** START OF EXECUTABLE CODE ********************** C C INITIALIZE THE SUMMATION VARIABLES. SM1 = 0.0 SM2 = 0.0 SM3 = 0.0 SM4 = 0.0 C C PERFORM THE SUMMATIONS OVER ALL ENTRIES. DO 1000 I = 1, NS TMP = AB**(2 * (I - 1)) SM1 = SM1 + (1.0 / TMP) SM4 = SM4 + (REAL(I - 1) / TMP) TMP = AB**(I - 1) SM2 = SM2 + ((DAT(I) * REAL(I - 1)) / TMP) SM3 = SM3 + (DAT(I) / TMP) 1000 CONTINUE C ENDDO C C CALCULATE THE FUNCTION VALUE. SGEOLS = SM1 * SM2 - SM3 * SM4 RETURN END SUBROUTINE SGEOMA G (DAT , NS , NSB , NSE , NSR , TYP Y ,STAT , RFLAG , INDX , V , VPRE ) C C *************************************************************** C * UNCLASSIFIED * C *************************************************************** C C CALLING SEQUENCE C SUBROUTINE SGEOMA C G (DAT , NS , NSB , NSE , NSR , TYP C Y ,STAT , RFLAG , INDX , V , VPRE ) C C AUTHOR C OLIVER D. SMITH (EG&G WASC) C CODE READ BY C WILLIAM H. FARR (B10, NSWCDD) C PURPOSE C TO PERFORM FOUR TYPES OF MODEL APPLICABILITY ANALYSIS FOR THE C GEOMETRIC MODEL. C C THESE INCLUDE: C 1) THE MODEL ACCURACY; C 2) THE MODEL BIAS; C 3) THE MODEL NOISE; AND C 4) THE MODEL TREND C DESCRIPTION C THE ROUTINE CONTROLS THE EXECUTIONS OF THE APPLICABLE SMFLIB C ROUTINE, SGEOMD. THE PROCESSING, AS DEFINED IN THE LITTLEWOOD C PAPER (SEE REFERENCES IN THE MAIN PROGRAM) BASICALLY INVOLVES A C SERIES OF EXECUTIONS WHERE NSB TO NSE DATA POINTS ARE UTILIZED C IN THE MODEL. C C FOR EACH ITERATION, THE MODEL PARAMETERS (ESTIMATES) FROM THE C CURRENT ITERATION ARE USED IN CONJUNCTION WITH THE OBSERVED DA- C TA FROM THE NEXT ITERATION POINT TO DETERMINE AN OVER-ALL PIC- C TURE OF THE APPLICABILITY OF THE MODEL FOR THE PARTICULAR DATA C SET. C C THIS ONE ROUTINE IS USED TO OBTAIN ALL FOUR ANALYSES; THE SIXTH C ARGUMENT, TYP, IS USED TO INDICATE HOW THE MODEL PARAMETERS ARE C TO BE USED. C C NOTE, THE VECTOR, V, IS NOT USED IN THE NOISE ANALYSIS AND THE C VECTOR, VPRE, IS ONLY USED IN THE BIAS ANALYSIS; HOWEVER, THEY C SHOULD BE AVAILABLE TO THE ROUTINE FOR ALL ACCESSES. C ASSUMPTIONS C (NONE) C RESTRICTIONS C (NONE) C PARAMETER GLOSSARY C (NONE) C GLOBAL GLOSSARY C (NONE) C ARGUMENT LIST C GIVEN C DAT (R) = ARRAY TO HOLD OBSERVED TBF DATA C NS (I) = THE "REAL" NUMBER OF ENTRIES (I.E., THE LAST C POINT IS NOT INCLUDED IF THE FATALITY FLAG IS C NOT SET) C NSB (I) = ANALYSIS ITERATION INDEX BEGINNING C NSE (I) = ANALYSIS ITERATION INDEX ENDING C NSR (I) = ANALYSIS ITERATION RANGE C TYP (I) = ANALYSIS TYPE TO BE PERFORMED (SEE PURPOSE) C YIELDED C INDX (I) = ANALYSIS ITERATION COUNTER (AT RETURN) C RFLAG (I) = MODEL RESULTS ERROR FLAG C STAT (R) = ANALYSIS RESULTS STATISTIC C V (R) = ANALYSIS RESULTS ARRAY OF SIZE NSR C VPRE (R) = VECTOR OF BIAS (U-PLOT) DATA PRIOR TO SORTING C LOCAL GLOSSARY C ESF (I) = MODEL ESTIMATION FLAG (ML ONLY) C STATS (R) = MODEL STATISTICS RESULTS ARRAY C SUMY (R) = SUM OF THE PREVIOUS Y'S C TMP (R) = INTERMEDIATE CALCULATION C TOTY (R) = SUM OF ALL THE Y'S C ERRORS C (NONE) C ASSOCIATED SUBPROGRAMS C SEE AUTOMATED CODE EXAMINER (ACE) OUTPUT C REFERENCES C SEE PROLOGUE OF MAIN PROGRAM C LANGUAGE C FORTRAN 77 C C *********************** START OF DECLARATIONS ************************ C C PRE-DECLARATION DEFAULT ASSIGNMENT IMPLICIT DOUBLE PRECISION (A-Z) C C GLOBAL SPECIFICATIONS C (NONE) C C ARGUMENT SPECIFICATIONS INTEGER INDX ,NS ,NSB 1 ,NSE ,NSR ,RFLAG 2 ,TYP DIMENSION DAT(NS) ,V(NSR) ,VPRE(NSR) C C LOCAL SPECIFICATIONS INTEGER ESF ,I DIMENSION STATS(4,3) C C ********************* START OF FORMAT STATEMENTS ********************* C C (NONE) C C ********************** START OF EXECUTABLE CODE ********************** C C INITIALIZE THE ITERATION COUNTER, STORAGE INDEX, MODEL ERROR C FLAG, RESULTS STATISTIC, AND SUM OF THE Y-PLOT VALUES LOCATION. I = NSB - 1 INDX = 0 RFLAG = 0 STAT = 0.0 TOTY = 0.0 C C INITIALIZE THE MODEL SELECTION FLAG TO INDICATE MAXIMUM LIKELI- C HOOD ANALYSIS (LEAST SQUARES IS NOT ALLOWED). ESF = 1 C IF (TYP.EQ.3) THEN C INITIALIZE THE CONSTANT PORTION OF THE NOISE CALCULATION. TMP = -LOG(0.5) ENDIF C C DOWHILE (PROCESSING LEFT AND NO ERRORS) 1000 I = I + 1 IF ((I.GT.NSE) .OR. (RFLAG.NE.0)) GO TO 1025 C C COMPUTE MODEL ESTIMATES. CALL SGEOMD G (ESF , I , DAT Y ,STATS , RFLAG ) C C INCREMENT THE ITERATION COUNTER FOR STORAGE. INDX = INDX + 1 C IF (RFLAG.EQ.0) THEN IF (TYP.EQ.1) THEN C ACCURACY ANALYSIS IS DESIRED; APPEND THE CONTRIBU- C TION OF THE CURRENT ITERATION TO THE PREQUENTIAL C LIKELIHOOD STATISTIC. V(INDX) = 0.0 - (LOG(STATS(2,1)) 1 + REAL(I) * LOG(STATS(1,1)) 2 - STATS(2,1) * STATS(1,1)**I * DAT(I+1)) STAT = STAT + V(INDX) C ELSEIF ((TYP.EQ.2) .OR. (TYP.EQ.4)) THEN C BIAS OR TREND ANALYSIS IS DESIRED; STORE THE FUNC- C TIONAL VALUE FOR THIS ELEMENT OF THE U-PLOT. V(INDX) = 1.0 1 - EXP(-STATS(2,1) * STATS(1,1)**I 2 * DAT(I+1)) IF (TYP.EQ.4) THEN C TREND ANALYSIS IS DESIRED; TRANSFORM THE U-PLOT C VALUE TO THE Y-PLOT REPRESENTATION. IF (V(INDX).LT.1.0) THEN V(INDX) = -LOG(1.0 - V(INDX)) TOTY = TOTY + V(INDX) ELSE RFLAG = 5 ENDIF ENDIF C ELSE C NOISE ANALYSIS IS DESIRED; COMPUTE THE FUNCTION FOR C THE NEXT POINT. MNXT = TMP / (STATS(2,1) * STATS(1,1)**I) C C PERFORM THE ADDITION OF THE NOISE ON ALL ITERATIONS C EXCEPT THE FIRST; AND THEN PREPARE FOR THE NEXT. IF (I.GT.NSB) THEN STAT = STAT + ABS((MNXT - MCUR) / MCUR) ENDIF MCUR = MNXT C ENDIF ENDIF GO TO 1000 1025 CONTINUE C ENDWHILE C IF ((TYP.EQ.2) .AND. (RFLAG.EQ.0)) THEN C COMPLETE THE COMPUTATION FOR THE U-PLOT VECTOR AND COMPUTE C THE KOLMOGOROV STATISTIC. FIRST STORE THE UNSORTED DATA. DO 1050 I = 1, NSR VPRE(I) = V(I) 1050 CONTINUE C ENDDO CALL CMPMAX G (NSR , 1 B ,STAT , V ) ENDIF C IF ((TYP.EQ.4) .AND. (RFLAG.EQ.0)) THEN C COMPLETE THE COMPUTATION FOR THE Y-PLOT VECTOR. SUMY = 0.0 DO 1075 I = 1, NSR SUMY = SUMY + V(I) V(I) = SUMY / TOTY 1075 CONTINUE C ENDDO C C COMPUTE THE KOLMOGOROV STATISTIC; NOTE, SORTING IS NOT RE- C QUIRED FOR THE Y-PLOT DATA. CALL CMPMAX G (NSR , 0 B ,STAT , V ) ENDIF RETURN END SUBROUTINE SGEOMD G (ESF , NS , DAT Y ,STATS , RFLAG ) C C *************************************************************** C * UNCLASSIFIED * C *************************************************************** C C CALLING SEQUENCE C SUBROUTINE SGEOMD C G (ESF , NS , DAT C Y ,STATS , RFLAG ) C C AUTHOR C OLIVER D. SMITH (EG&G WASC) C DEKKER-BRENT IMPLEMENTATION BY C JAMES S. VANDERGRAFT (COMPUTATIONAL ENGINEERING, INC) C DEKKER-BRENT CODE STRUCTURING BY C PAUL J. KRAUS & CINDY A. WELLS (COMPUTATIONAL ENGINEERING, INC) C CODE READ BY C WILLIAM H. FARR (B10, NSWCDD) & OLIVER D. SMITH (EG&G WASC) C PURPOSE C TO CALCULATE THE ESTIMATES USING THE MAXIMUM LIKELIHOOD AND C LEAST SQUARES METHODS OF THE GEOMETRIC MODEL. C DESCRIPTION C THE FIRST ARGUMENT OF THE CALL LINE (ESF) WILL BE USED BY THE C ROUTINE TO DETERMINE WHICH OF THE TWO METHODS OF EXECUTION IS C DESIRED. C C ONCE THE ITERATIVE EXECUTION IS INITIATED, PROCESSING WILL CON- C TINUE UNTIL ONE OF TWO POSSIBLE TERMINATION STATES IS REACHED. C THE LAST ARGUMENT OF THE CALL LINE (RFLAG) WILL BE SET TO INDI- C CATE TO THE CALLING ROUTINE THE REASON FOR EXIT. THE POSSIBLE C REASONS FOR SGEOMD EXIT ARE: C 0 - SUCCESSFUL CONVERGENCE WITHIN THE MODEL C 3 - THE DATA ARE NOT APPROPRIATE FOR THE MODEL. C C THE RESULTANT STATISTICS WILL BE RETURNED IN THE STATS ARGUMENT C FOR A RFLAG VALUE OF 0 ONLY. FOR THE MAXIMUM LIKELIHOOD C METHOD, THIS WILL INCLUDE THE FOUR STATISTICS AND THEIR 95% C CONFIDENCE INTERVALS. UNDER THE LEAST SQUARES METHOD, THE CON- C FIDENCE INTERVALS WILL NOT BE COMPUTED. C ASSUMPTIONS C (NONE) C RESTRICTIONS C THIS SUBPROGRAM CONTAINS CODE WHICH DOES NOT COMPLY WITH THE C PROGRAMMING STANDARDS; GROUP LEADER APPROVAL HAS BEEN OBTAINED. C -SPECIFICALLY: C THE ARGUMENT FC IN THE ACCESS TO THE ROUTINE ZERO, IS ACTUALLY C INITIALIZED IN THE ACCESSED ROUTINE. WHEN ICOUNT HAS A VALUE OF C MORE THAN ONE, THE ARGUMENT BECOMES A BOTH (AS MARKED). HENCE, C FC APPEARS UNDEFINED IN THIS ROUTINE'S COMPILATION LISTING. C PARAMETER GLOSSARY C (NONE) C GLOBAL GLOSSARY C (NONE) C ARGUMENT LIST C GIVEN C DAT (R) = TBF VECTOR (WC OR CPU) C ESF (I) = ESTIMATION SELECTION FLAG C NS (I) = SIZE OF DAT C YIELDED C RFLAG (I) = RETURN STATUS FLAG C STATS (R) = RESULTS ARRAY C LOCAL GLOSSARY C A (R) = LOWER BOUND OF PROPORTIONALITY CONSTANT C B (R) = UPPER BOUND OF PROPORTIONALITY CONSTANT C COUNT (I) = ITERATION COUNTER C FA (R) = VALUE OF FUNCTION AT A C FB (R) = VALUE OF FUNCTION AT B C FC (R) = VALUE OF FUNCTION AT C C ICOUNT (I) = STEP COUNTER C IFLAG (I) = CONVERGENCE FLAG C RN (R) = REAL VARIABLE STORAGE OF NS C S1 (R) = SUMMATION VARIABLE C S2 (R) = SUMMATION VARIABLE C TMP (R) = INTERMEDIATE CALCULATION C ERRORS C RFLAG = 3 : THE DATA ARE NOT APPROPRIATE FOR THE MODEL. C ASSOCIATED SUBPROGRAMS C SEE AUTOMATED CODE EXAMINER (ACE) OUTPUT C REFERENCES C SEE PROLOGUE OF MAIN PROGRAM C LANGUAGE C FORTRAN 77 C C *********************** START OF DECLARATIONS ************************ C C PRE-DECLARATION DEFAULT ASSIGNMENT IMPLICIT DOUBLE PRECISION (A-Z) C C PARAMETER SPECIFICATIONS C (NONE) C C GLOBAL SPECIFICATIONS C (NONE) C C ARGUMENT SPECIFICATIONS INTEGER ESF ,NS ,RFLAG DIMENSION DAT(NS) ,STATS(4,3) C C LOCAL SPECIFICATIONS INTEGER COUNT ,I ,ICOUNT 1 ,IFLAG C C ********************* START OF FORMAT STATEMENTS ********************* C C (NONE) C C ********************** START OF EXECUTABLE CODE ********************** C C SET THE COUNTER AND RETURN STATUS FLAG. COUNT = 0 RFLAG = -1 C C ZERO ALL LOCATIONS OF THE RESULTS VECTOR. DO 1000 I = 1, 4 STATS(I,1) = 0.0 STATS(I,2) = 0.0 STATS(I,3) = 0.0 1000 CONTINUE C ENDDO C C COMPUTE THE VALUE OF THE FUNCTION AT ITS UPPER BOUND. B = .999 A = B / 2.0 IF (ESF.EQ.1) THEN FB = SGEOML G (B , DAT , NS ) ELSE FB = SGEOLS G (B , DAT , NS ) ENDIF C C COMPUTE THE VALUE OF THE FUNCTION AT A POINT WHERE ITS SIGN IS C THE OPPOSITE OF THE COMPUTED VALUE AT THE FUNCTIONS UPPER C BOUND. C C DOWHILE (RFLAG .EQ. -1) 1025 COUNT = COUNT + 1 IF (ESF.EQ.1) THEN FA = SGEOML G (A , DAT , NS ) ELSE FA = SGEOLS G (A , DAT , NS ) ENDIF C C SET RFLAG, IF CONVERGENCE POSSIBLE. IF ((FA*FB).LE.0.0) THEN RFLAG = 0 ENDIF C C SET RFLAG, IF THE DATA ARE NOT APPROPRIATE FOR THE MODEL. IF (COUNT.GE.5) THEN RFLAG = 3 ENDIF IF (RFLAG.EQ.-1) THEN A = A / 2.0 ENDIF IF (RFLAG.EQ.-1) GO TO 1025 C ENDWHILE C IF (RFLAG.EQ.0) THEN C COMPUTE THE ESTIMATE OF THE PROPORTIONALITY CONSTANT AND C STORE THE VALUE IN STATS(1,1). IFLAG = -1 ICOUNT = 1 C C DOWHILE (IFLAG .EQ. -1) C COMPUTE THE ZERO OF THE FUNCTION IN THE INTERVAL A AND C B; NOTE THE ARGUMENT FC IS INITIALIZED BY THE ZERO ROU- C TINE WHEN ICOUNT IS SET TO ONE. <