1*SETAF 2 SUBROUTINE SETAF 3 + (FUN,N,NP,M,XPLUSD,LDXPD,BETA,ETA,NETA,EPSMAC, 4 + NROW,PARTMP,PVTEMP,IFLAG) 5C***BEGIN PROLOGUE SETAF 6C***REFER TO SODR,SODRC 7C***ROUTINES CALLED (NONE) 8C***DATE WRITTEN 860529 (YYMMDD) 9C***REVISION DATE 870204 (YYMMDD) 10C***CATEGORY NO. G2E,I1B1 11C***KEYWORDS ORTHOGONAL DISTANCE REGRESSION, 12C NONLINEAR LEAST SQUARES, 13C ERRORS IN VARIABLES 14C***AUTHOR BOGGS, PAUL T. 15C OPTIMIZATION GROUP/SCIENTIFIC COMPUTING DIVISION 16C NATIONAL BUREAU OF STANDARDS, GAITHERSBURG, MD 20899 17C BYRD, RICHARD H. 18C DEPARTMENT OF COMPUTER SCIENCE 19C UNIVERSITY OF COLORADO, BOULDER, CO 80309 20C DONALDSON, JANET R. 21C OPTIMIZATION GROUP/SCIENTIFIC COMPUTING DIVISION 22C NATIONAL BUREAU OF STANDARDS, BOULDER, CO 80303-3328 23C SCHNABEL, ROBERT B. 24C DEPARTMENT OF COMPUTER SCIENCE 25C UNIVERSITY OF COLORADO, BOULDER, CO 80309 26C AND 27C OPTIMIZATION GROUP/SCIENTIFIC COMPUTING DIVISION 28C NATIONAL BUREAU OF STANDARDS, BOULDER, CO 80303-3328 29C***PURPOSE COMPUTE NOISE AND NUMBER OF GOOD DIGITS IN FUNCTION RESULTS 30C (THIS ROUTINE IS MODELED AFTER STARPAC SUBROUTINE ETAFUN) 31C***END PROLOGUE SETAF 32C 33C EXTERNALS 34C 35 EXTERNAL FUN 36C THE NAME OF USER-SUPPLIED ROUTINE FOR COMPUTING THE MODEL. 37C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE SECTION V.B, 38C ARGUMENT FUN.) 39C 40C VARIABLE DECLARATIONS (ALPHABETICALLY) 41C 42 REAL A 43C PARAMETERS OF THE FIT. 44 REAL B 45C PARAMETERS OF THE FIT. 46 REAL BETA(NP) 47C THE FUNCTION PARAMETERS. 48C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 49 REAL EPSMAC 50C THE VALUE OF MACHINE PRECISION. 51 REAL ETA 52C THE NOISE IN THE MODEL RESULTS. 53 REAL FAC 54C A FACTOR USED IN THE COMPUTATIONS. 55 INTEGER I 56C AN INDEXING VARIABLE. 57 INTEGER IFLAG 58C AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE THAT THE 59C USER WISHES THE COMPUTATIONS STOPPED. 60 REAL J 61C THE VALUE FLOAT(I-3). 62 INTEGER K 63C AN INDEX VARIABLE. 64 INTEGER LDXPD 65C THE LEADING DIMENSION OF ARRAY XPLUSD. 66 INTEGER M 67C THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE. 68C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 69 INTEGER N 70C THE NUMBER OF OBSERVATIONS. 71C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 72 INTEGER NETA 73C THE NUMBER OF ACCURATE DIGITS IN THE MODEL RESULTS. 74 INTEGER NP 75C THE NUMBER OF FUNCTION PARAMETERS. 76C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 77 INTEGER NROW 78C THE NUMBER OF THE ROW AT WHICH THE DERIVATIVE IS TO BE CHECKED. 79 REAL ONE 80C THE VALUE 1.0E0. 81 REAL P1 82C THE VALUE 0.1E0. 83 REAL P2 84C THE VALUE 0.2E0. 85 REAL PARTMP(NP) 86C MODIFIED MODEL PARAMETERS 87 REAL PVTEMP(N) 88C PREDICTED VALUES 89 REAL RSS(5) 90C THE RESIDUAL SUM OF SQUARES FOR EACH VALUE OF J. 91 REAL RSSSM 92C THE SUM OF THE RESIDUAL SUM OF SQUARES FOR EACH SET OF 93C PARAMETER VALUES. 94 REAL RSSSMJ 95C THE SUM OF THE RESIDUAL SUM OF SQUARES TIMES J FOR EACH 96C SET OF PARAMETER VALUES. 97 REAL SQRTMP 98C THE SQUARE ROOT OF MACHINE PRECISION (EPSMAC). 99 REAL XPLUSD(LDXPD,M) 100C THE ARRAY X + DELTA. 101 REAL ZERO 102C THE VALUE 0.0E0. 103C 104C 105 DATA ZERO,P1,P2,ONE/0.0E0,0.1E0,0.2E0,1.0E0/ 106C 107C 108C***FIRST EXECUTABLE STATEMENT SETAF 109C 110C 111 SQRTMP = SQRT(EPSMAC) 112 RSSSM = ZERO 113 RSSSMJ = ZERO 114 DO 20 I=1,5 115 J = I-3 116 DO 10 K=1,NP 117 PARTMP(K) = BETA(K)*(ONE+J*SQRTMP) 118 10 CONTINUE 119 IFLAG = 0 120 CALL FUN(N,NP,M,PARTMP,XPLUSD,LDXPD,PVTEMP,IFLAG) 121 IF (IFLAG.LT.0) THEN 122 RETURN 123 END IF 124C 125 RSS(I) = PVTEMP(NROW) 126C 127 RSSSM = RSSSM + RSS(I) 128 RSSSMJ = RSSSMJ + J*RSS(I) 129 20 CONTINUE 130 A = P2*RSSSM 131 B = P1*RSSSMJ 132 IF (RSS(3).NE.ZERO) THEN 133 FAC = ONE/ABS(RSS(3)) 134 ELSE 135 FAC = ONE 136 END IF 137 DO 30 I=1,5 138 J = I-3 139 RSS(I) = ABS((RSS(I)-(A+J*B))*FAC) 140 30 CONTINUE 141 ETA = MAX(RSS(1),RSS(2),RSS(3),RSS(4),RSS(5),EPSMAC) 142 NETA = INT(-LOG10(ETA)) 143C 144 RETURN 145 END 146