1*DODPC3 2 SUBROUTINE DODPC3 3 + (IPR,LUNRPT, 4 + N,M,NP, 5 + INFO,NJEV,NFEV,RCOND,IRANK, 6 + RNORM,DELWTD,FWTD, 7 + BETA,F,ISODR,DELTA) 8C***BEGIN PROLOGUE DODPC3 9C***REFER TO DODR,DODRC 10C***ROUTINES CALLED DNRM2 11C***DATE WRITTEN 860529 (YYMMDD) 12C***REVISION DATE 870204 (YYMMDD) 13C***CATEGORY NO. G2E,I1B1 14C***KEYWORDS ORTHOGONAL DISTANCE REGRESSION, 15C NONLINEAR LEAST SQUARES, 16C ERRORS IN VARIABLES 17C***AUTHOR BOGGS, PAUL T. 18C OPTIMIZATION GROUP/SCIENTIFIC COMPUTING DIVISION 19C NATIONAL BUREAU OF STANDARDS, GAITHERSBURG, MD 20899 20C BYRD, RICHARD H. 21C DEPARTMENT OF COMPUTER SCIENCE 22C UNIVERSITY OF COLORADO, BOULDER, CO 80309 23C DONALDSON, JANET R. 24C OPTIMIZATION GROUP/SCIENTIFIC COMPUTING DIVISION 25C NATIONAL BUREAU OF STANDARDS, BOULDER, CO 80303-3328 26C SCHNABEL, ROBERT B. 27C DEPARTMENT OF COMPUTER SCIENCE 28C UNIVERSITY OF COLORADO, BOULDER, CO 80309 29C AND 30C OPTIMIZATION GROUP/SCIENTIFIC COMPUTING DIVISION 31C NATIONAL BUREAU OF STANDARDS, BOULDER, CO 80303-3328 32C***PURPOSE GENERATE FINAL SUMMARY REPORT 33C***END PROLOGUE DODPC3 34C 35C FUNCTION DECLARATIONS 36C 37 DOUBLE PRECISION DNRM2 38C 39C VARIABLE DECLARATIONS (ALPHABETICALLY) 40C 41 DOUBLE PRECISION BETA(NP) 42C THE FUNCTION PARAMETERS. 43C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 44 DOUBLE PRECISION DELTA(N,M) 45C THE ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES. 46 DOUBLE PRECISION DELWTD(N,M) 47C THE WEIGHTED ESTIMATED ERRORS IN THE INDEPENDENT VARIABLES. 48 DOUBLE PRECISION F(N) 49C THE (WEIGHTED) ESTIMATED VALUES OF EPSILON. 50 CHARACTER*90 FMT1 51C A CHARACTER VARIABLE USED FOR FORMATS. 52 DOUBLE PRECISION FWTD(N) 53C THE WEIGHTED ESTIMATED VALUES OF EPSILON. 54 INTEGER I 55C AN INDEXING VARIABLE. 56 INTEGER INFO 57C AN INDICATOR VARIABLE, USED PRIMARILY TO DESIGNATE WHY THE 58C COMPUTATIONS WERE STOPPED. 59 INTEGER INFO1 60C THE FIRST DIGIT OF INFO. 61 INTEGER INFO2 62C THE SECOND DIGIT OF INFO. 63 INTEGER INFO3 64C THE THIRD DIGIT OF INFO. 65 INTEGER IPR 66C THE VALUE WHICH CONTROLS THE REPORT BEING PRINTED. 67 INTEGER IRANK 68C THE RANK DEFICIENCY OF THE JACOBIAN WRT BETA. 69 LOGICAL ISODR 70C THE INDICATOR VARIABLE USED TO DESIGNATE WHETHER THE SOLUTION 71C IS TO BE FOUND BY ODR (ISODR=.TRUE.) OR BY OLS (ISODR=.FALSE.). 72 INTEGER J 73C AN INDEXING VARIABLE. 74 INTEGER K 75C AN INDEXING VARIABLE. 76 INTEGER L 77C AN INDEXING VARIABLE. 78 INTEGER LAST 79C THE LAST ROW OF THE GIVEN ARRAY TO BE PRINTED. 80 INTEGER LUNRPT 81C THE LOGICAL UNIT NUMBER USED FOR COMPUTATION REPORTS. 82C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 83 INTEGER M 84C THE NUMBER OF COLUMNS OF DATA IN THE INDEPENDENT VARIABLE. 85C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 86 INTEGER MAXLST 87C THE MAXIMUM NUMBER OF ITEMS TO BE PRINTED. 88 INTEGER N 89C THE NUMBER OF OBSERVATIONS. 90C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 91 INTEGER NFEV 92C THE NUMBER OF FUNCTION EVALUATIONS. 93 INTEGER NJEV 94C THE NUMBER OF JACOBIAN EVALUATIONS. 95 INTEGER NP 96C THE NUMBER OF FUNCTION PARAMETERS. 97C (FOR DETAILS, SEE ODRPACK REFERENCE GUIDE.) 98 INTEGER NPLM1 99C THE NUMBER OF ITEMS TO BE PRINTED PER LINE, MINUS ONE. 100 DOUBLE PRECISION RCOND 101C THE APPROXIMATE RECIPROCAL CONDITION OF TFJACB. 102 DOUBLE PRECISION RNORM 103C THE NORM OF THE WEIGHTED OBSERVATIONAL ERRORS. 104 DOUBLE PRECISION ZERO 105C THE VALUE 0.0D0. 106C 107C 108 DATA ZERO/0.0D0/ 109C 110C 111C***FIRST EXECUTABLE STATEMENT DODPC3 112C 113C 114C PRINT STOPPING CONDITIONS 115C 116 WRITE (LUNRPT,1000) INFO 117 IF (INFO.LT.0) THEN 118 WRITE (LUNRPT,1110) 119 ELSE 120 INFO1 = MOD(INFO,1000)/100 121 INFO2 = MOD(INFO,100)/10 122 INFO3 = MOD(INFO,10) 123C 124 IF (INFO3.EQ.1) THEN 125 WRITE (LUNRPT,1120) 126 ELSE IF (INFO3.EQ.2) THEN 127 WRITE (LUNRPT,1130) 128 ELSE IF (INFO3.EQ.3) THEN 129 WRITE (LUNRPT,1140) 130 ELSE IF (INFO3.EQ.4) THEN 131 WRITE (LUNRPT,1150) 132 ELSE 133 WRITE (LUNRPT,1160) 134 END IF 135C 136C PRINT WARNING DIAGNOSTICS 137C 138 IF (INFO1.NE.0 .OR. INFO2.NE.0) THEN 139 WRITE (LUNRPT,1210) 140 IF (INFO1.NE.0) THEN 141 IF (INFO2.NE.0) THEN 142 WRITE (LUNRPT,1220) ', AND' 143 ELSE 144 WRITE (LUNRPT,1220) '. ' 145 END IF 146 END IF 147 IF (INFO2.NE.0) THEN 148 WRITE (LUNRPT,1230) 149 END IF 150 END IF 151 END IF 152C 153C PRINT MISC. STOPPING INFO 154C 155 WRITE (LUNRPT,1300) NJEV,NFEV,RCOND,IRANK 156C 157C PRINT FINAL SUM OF SQUARES 158C 159 WRITE (LUNRPT,2000) 160 WRITE (LUNRPT,2100) RNORM**2 161 IF (ISODR) THEN 162 WRITE (LUNRPT,2200) DNRM2(N*M,DELWTD,1)**2 163 WRITE (LUNRPT,2300) DNRM2(N,FWTD,1)**2 164 END IF 165C 166 NPLM1 = 3 167C 168C PRINT ESTIMATED BETA'S 169C 170 WRITE (LUNRPT,3000) 171 IF (NP.EQ.1) THEN 172 WRITE (LUNRPT,7100) 173 ELSE 174 WRITE (LUNRPT,7200) 175 END IF 176 DO 10 J=1,NP,NPLM1+1 177 K = MIN(J+NPLM1,NP) 178 IF (K.EQ.J) THEN 179 WRITE (LUNRPT,8100) J,BETA(J) 180 ELSE 181 WRITE (LUNRPT,8200) J,K,(BETA(L),L=J,K) 182 END IF 183 10 CONTINUE 184C 185C PRINT ESTIMATED EPSILON'S AND DELTA'S 186C 187 MAXLST = 32 188 IF (IPR.GE.2 .OR. N.LT.MAXLST) THEN 189 LAST = N 190 ELSE 191 LAST = MAXLST 192 END IF 193C 194C PRINT EPSILON'S AND DELTA'S TOGETHER IN A COLUMN IF THE NUMBER OF 195C COLUMNS OF DATA IN DELTA IS LESS THAN OR EQUAL TO THREE. 196C 197 IF (ISODR .AND. M.LE.3) THEN 198 WRITE (LUNRPT,4100) 199 WRITE (FMT1,9100) M 200 WRITE (LUNRPT,FMT1) (J,J=1,M) 201 DO 20 I=1,LAST 202 WRITE (LUNRPT,4110) I,F(I),(DELTA(I,J),J=1,M) 203 20 CONTINUE 204 IF (N.GT.LAST) THEN 205 IF (N.LE.LAST+4) THEN 206 DO 30 I=LAST+1,N 207 WRITE (LUNRPT,4110) I,F(I),(DELTA(I,J),J=1,M) 208 30 CONTINUE 209 ELSE 210 WRITE (FMT1,9200) M+1 211 WRITE (LUNRPT,FMT1) 212 WRITE (LUNRPT,FMT1) 213 WRITE (LUNRPT,FMT1) 214 WRITE (LUNRPT,4110) N,F(N),(DELTA(N,J),J=1,M) 215 END IF 216 END IF 217 ELSE 218C 219C PRINT EPSILON'S AND DELTA'S SEPARATELY 220C 221C PRINT EPSILON'S 222C 223 WRITE (LUNRPT,4200) 224 IF (LAST.EQ.1) THEN 225 WRITE (LUNRPT,7100) 226 ELSE 227 WRITE (LUNRPT,7200) 228 END IF 229 DO 40 I=1,LAST,NPLM1+1 230 K = MIN(I+NPLM1,LAST) 231 IF (I.EQ.K) THEN 232 WRITE (LUNRPT,8100) I,F(I) 233 ELSE 234 WRITE (LUNRPT,8200) I,K,(F(L),L=I,K) 235 END IF 236 40 CONTINUE 237 IF (N.GT.LAST) THEN 238 IF (N.EQ.LAST+1) THEN 239 WRITE (LUNRPT,8100) N,F(N) 240 ELSE IF (N.GT.LAST+1) THEN 241 WRITE (LUNRPT,8300) N,F(N) 242 END IF 243 END IF 244C 245C PRINT DELTA'S 246C 247 IF (ISODR) THEN 248 DO 60 J=1,M 249 WRITE (LUNRPT,4300) J 250 IF (LAST.EQ.1) THEN 251 WRITE (LUNRPT,7100) 252 ELSE 253 WRITE (LUNRPT,7200) 254 END IF 255 DO 50 I=1,LAST,NPLM1+1 256 K = MIN(I+NPLM1,LAST) 257 IF (I.EQ.K) THEN 258 WRITE (LUNRPT,8100) I,DELTA(I,J) 259 ELSE 260 WRITE (LUNRPT,8200) I,K,(DELTA(L,J),L=I,K) 261 END IF 262 50 CONTINUE 263 IF (N.EQ.LAST+1) THEN 264 WRITE (LUNRPT,8100) N,DELTA(N,J) 265 ELSE IF (N.GT.LAST+1) THEN 266 WRITE (LUNRPT,8300) N,DELTA(N,J) 267 END IF 268 60 CONTINUE 269 END IF 270 END IF 271C 272 RETURN 273C 274C FORMAT STATEMENTS 275C 276 1000 FORMAT 277 + (///' STOPPING CONDITION (INFO = ',I6,'):'/ 278 + ' -----------------------------------'/) 279 1110 FORMAT 280 + ( ' THE USER HAS STOPPED THE COMPUTATIONS'/ 281 + ' IN USER-SUPPLIED SUBROUTINE FUN OR JAC') 282 1120 FORMAT 283 + ( ' THE RELATIVE CHANGE IN THE SUM OF THE SQUARED'/ 284 + ' WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL') 285 1130 FORMAT 286 + ( ' THE RELATIVE CHANGE IN THE NORM OF BETA AND DELTA'/ 287 + ' IS LESS THAN PARTOL') 288 1140 FORMAT 289 + ( ' THE RELATIVE CHANGE IN THE SUM OF THE SQUARED'/ 290 + ' WEIGHTED OBSERVATIONAL ERRORS IS LESS THAN SSTOL'/ 291 + ' AND'/ 292 + ' THE RELATIVE CHANGE IN THE NORM OF BETA AND DELTA'/ 293 + ' IS LESS THAN PARTOL') 294 1150 FORMAT 295 + ( ' MAXIMUM NUMBER OF ITERATIONS REACHED') 296 1160 FORMAT 297 + ( ' ERROR. PLEASE CHECK WITH AUTHORS.') 298 1210 FORMAT 299 + (/ ' NOTE:'// 300 + ' THE RESULTS FROM ODRPACK ARE QUESTIONABLE BECAUSE'/) 301 1220 FORMAT 302 + ( ' THE ODRPACK JACOBIAN MATRIX CHECKING PROCEDURE HAS '/ 303 + ' DETERMINED THAT THE CORRECTNESS OF THE USER-SUPPLIED'/ 304 + ' JACOBIAN MATRICES IS QUESTIONABLE',A5/) 305 1230 FORMAT 306 + ( ' THE RESULTS OF THE MODEL FUNCTION AND/OR ITS '/ 307 + ' DERIVATIVES ARE UNAFFECTED BY CHANGES IN THE UNFIXED'/ 308 + ' FUNCTION PARAMETERS (BETA), INDICATING A PROBABLE '/ 309 + ' ERROR IN USER-SUPPLIED SUBROUTINES FUN AND/OR JAC. ') 310 1300 FORMAT 311 + (/' CONDITION '/ 312 + ' NUMBER OF NUMBER OF NUMBER RANK'/ 313 + ' ITERATIONS FN EVALS (INVERSE) DEFICIENCY'/ 314 + 6X,I10,I11,D11.4,6X,I6) 315 2000 FORMAT 316 + (///' FINAL SUMS OF SQUARES:'/ 317 + ' ----------------------'/) 318 2100 FORMAT 319 + ( ' SUM OF SQUARED WEIGHTED OBSERVATIONAL ERRORS ', D17.8) 320 2200 FORMAT 321 + ( ' SUM OF SQUARED WEIGHTED DELTAS ', D17.8) 322 2300 FORMAT 323 + ( ' SUM OF SQUARED WEIGHTED EPSILONS ', D17.8) 324 3000 FORMAT 325 + (///' ESTIMATED BETA(I), I = 1, ..., NP:'/ 326 + ' ----------------------------------') 327 4100 FORMAT 328 + (///' ESTIMATED EPSILON(I) AND DELTA(I,*), I = 1, ..., N:'/ 329 + ' ---------------------------------------------------') 330 4110 FORMAT(1X,I5,5D16.8) 331 4200 FORMAT 332 + (///' ESTIMATED EPSILON(I), I = 1, ..., N:'/ 333 + ' ------------------------------------') 334 4300 FORMAT 335 + (///' ESTIMATED DELTA(I,',I3,'), I = 1, ..., N:'/ 336 + ' --------------------------------------') 337 7100 FORMAT 338 + (/' INDEX VALUE') 339 7200 FORMAT 340 + (/' INDEX VALUE -------------->') 341 8100 FORMAT 342 + (9X,I5,1X,D16.8) 343 8200 FORMAT 344 + (1X,I5,' TO',I5,1X,7D16.8) 345 8300 FORMAT 346 + (1X,' ... TO',I5,1X,' ... ',D16.8) 347 9100 FORMAT 348 + ('(/'' I EPSILON(I)'',',I1, 349 + '('' DELTA(I,'',I1,'')''))') 350 9200 FORMAT('(5X,''.'',',I1,'(3X,''.'',12X))') 351 END 352