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