print_report_final Subroutine

   impure subroutine print_report_final &
      (ipr, lunrpt, &
       isodr, implicit, didvcv, dovcv, redoj, anajac, &
       n, m, np, q, npp, &
       info, niter, nfev, njev, irank, rcond, istop, &
       wss, wssdel, wsseps, penalty, rvar, idf, &
       beta, sdbeta, ifixb2, f, delta, &
       lower, upper)
   !! Generate final summary report.

      use odrpack_core, only: ppf_tstudent

      integer, intent(in) :: ipr
         !! Variable indicating what is to be printed.
      integer, intent(in) :: lunrpt
         !! Logical unit number used for computation reports.
      logical, intent(in) :: isodr
         !! Variable designating whether the solution is by ODR (`.true.`) or by OLS (`.false.`).
      logical, intent(in) :: implicit
         !! Variable designating whether the solution is by implicit ODR (`.true.`)
         !! or explicit ODR (`.false.`).
      logical, intent(in) :: didvcv
         !! Variable designating whether the covariance matrix was computed (`.true.`)
         !! or not (`.false.`).
      logical, intent(in) :: dovcv
         !! Variable designating whether the covariance matrix was to be computed
         !! (`.true.`) or not (`.false.`).
      logical, intent(in) :: redoj
         !! Variable designating whether the Jacobian matrix is to be recomputed for the
         !! computation of the covariance matrix (`.true.`) or not (`.false.`).
      logical, intent(in) :: anajac
         !! Variable designating whether the Jacobians are computed by finite differences
         !! (`.false.`) or not (`.true.`).
      integer, intent(in) :: n
         !! Number of observations.
      integer, intent(in) :: m
         !! Number of columns of data in the explanatory variable.
      integer, intent(in) :: np
         !! Number of function parameters.
      integer, intent(in) :: q
         !! Number of responses per observation.
      integer, intent(in) :: npp
         !! Number of function parameters being estimated.
      integer, intent(in) :: info
         !! Variable designating why the computations were stopped.
      integer, intent(in) :: niter
         !! Number of iterations.
      integer, intent(in) :: nfev
         !! Number of function evaluations.
      integer, intent(in) :: njev
         !! Number of Jacobian evaluations.
      integer, intent(in) :: irank
         !! Rank deficiency of the Jacobian with respect to `beta`.
      real(wp), intent(in) :: rcond
         !! Approximate reciprocal condition of `tfjacb`.
      integer, intent(in) :: istop
         !! Variable designating whether there are problems computing the function at the
         !! current `beta` and `delta`.
      real(wp), intent(in) :: wss
         !! Sum-of-squares of the weighted `epsilon`s and `delta`s.
      real(wp), intent(in) :: wssdel
         !! Sum-of-squares of the weighted `delta`s.
      real(wp), intent(in) :: wsseps
         !! Sum-of-squares of the weighted `epsilon`s.
      real(wp), intent(in) :: penalty
         !! Penalty parameter for an implicit model.
      real(wp), intent(in) :: rvar
         !! Residual variance.
      integer, intent(in) :: idf
         !! Degrees of freedom of the fit, equal to the number of observations with nonzero
         !! weighted derivatives minus the number of parameters being estimated.
      real(wp), intent(in) :: beta(np)
         !! Function parameters.
      real(wp), intent(in) :: sdbeta(np)
         !! Standard errors of the estimated parameters.
      integer, intent(in) :: ifixb2(np)
         !! Values designating whether the elements of `beta` were estimated, fixed, or
         !! dropped because they caused rank deficiency.
      real(wp), intent(in) :: f(n, q)
         !! Estimated values of `epsilon`.
      real(wp), intent(in) :: delta(n, m)
         !! Estimated errors in the explanatory variables.
      real(wp), intent(in) :: lower(np)
         !! Lower bound on `beta`.
      real(wp), intent(in) :: upper(np)
         !! Upper bound on `beta`.

      ! Local scalars
      real(wp) :: tval
      integer :: d1, d2, d3, d4, d5, i, j, k, l, nplm1
      character(len=90) :: fmt1

      ! Variable Definitions (alphabetically)
      !  D1:      The first digit of INFO.
      !  D2:      The second digit of INFO.
      !  D3:      The third digit of INFO.
      !  D4:      The fourth digit of INFO.
      !  D5:      The fifth digit of INFO.
      !  FMT1:    A CHARACTER*90 variable used for formats.
      !  I:       An indexing variable.
      !  J:       An indexing variable.
      !  K:       An indexing variable.
      !  L:       An indexing variable.
      !  NPLM1:   The number of items to be printed per line, minus one.
      !  TVAL:    The value of the 97.5 percent point function for the T distribution.

      d1 = info/10000
      d2 = mod(info, 10000)/1000
      d3 = mod(info, 1000)/100
      d4 = mod(info, 100)/10
      d5 = mod(info, 10)

      ! Print stopping conditions
      write (lunrpt, 1000)
      if (info <= 9) then
         if (info == 1) then
            write (lunrpt, 1011) info
         elseif (info == 2) then
            write (lunrpt, 1012) info
         elseif (info == 3) then
            write (lunrpt, 1013) info
         elseif (info == 4) then
            write (lunrpt, 1014) info
         elseif (info <= 9) then
            write (lunrpt, 1015) info
         end if
      elseif (info <= 9999) then

         ! Print warning diagnostics
         write (lunrpt, 1020) info
         if (d2 == 1) write (lunrpt, 1021)
         if (d3 == 1) write (lunrpt, 1022)
         if (d4 == 1) write (lunrpt, 1023)
         if (d4 == 2) write (lunrpt, 1024)
         if (d5 == 1) then
            write (lunrpt, 1031)
         elseif (d5 == 2) then
            write (lunrpt, 1032)
         elseif (d5 == 3) then
            write (lunrpt, 1033)
         elseif (d5 == 4) then
            write (lunrpt, 1034)
         elseif (d5 <= 9) then
            write (lunrpt, 1035) d5
         end if
      else

         ! Print error messages
         write (lunrpt, 1040) info
         if (d1 == 5) then
            write (lunrpt, 1042)
            if (d2 /= 0) write (lunrpt, 1043) d2
            if (d3 == 3) then
               write (lunrpt, 1044) d3
            elseif (d3 /= 0) then
               write (lunrpt, 1045) d3
            end if
         elseif (d1 == 6) then
            write (lunrpt, 1050)
         else
            write (lunrpt, 1060) d1
         end if
      end if

      ! Print misc. stopping info
      write (lunrpt, 1300) niter
      write (lunrpt, 1310) nfev
      if (anajac) write (lunrpt, 1320) njev
      write (lunrpt, 1330) irank
      write (lunrpt, 1340) rcond
      write (lunrpt, 1350) istop

      ! Print final sum of squares
      if (implicit) then
         write (lunrpt, 2000) wssdel
         if (isodr) then
            write (lunrpt, 2010) wss, wsseps, penalty
         end if
      else
         write (lunrpt, 2100) wss
         if (isodr) then
            write (lunrpt, 2110) wssdel, wsseps
         end if
      end if
      if (didvcv) then
         write (lunrpt, 2200) sqrt(rvar), idf
      end if

      nplm1 = 3

      ! Print estimated BETA's, and, if, full rank, their standard errors
      write (lunrpt, 3000)
      if (didvcv) then
         write (lunrpt, 7300)
         tval = ppf_tstudent(0.975E0_wp, idf)
         do j = 1, np
            if (ifixb2(j) >= 1) then
               write (lunrpt, 8400) j, beta(j), &
                  lower(j), upper(j), &
                  sdbeta(j), &
                  beta(j) - tval*sdbeta(j), &
                  beta(j) + tval*sdbeta(j)
            elseif (ifixb2(j) == 0) then
               write (lunrpt, 8600) j, beta(j), lower(j), upper(j)
            else
               write (lunrpt, 8700) j, beta(j), lower(j), upper(j)
            end if
         end do
         if (.not. redoj) write (lunrpt, 7310)
      else
         if (dovcv) then
            if (d1 <= 5) then
               write (lunrpt, 7410)
            else
               write (lunrpt, 7420)
            end if
         end if

         if ((irank == 0 .and. npp == np) .or. niter == 0) then
            if (np == 1) then
               write (lunrpt, 7100)
            else
               write (lunrpt, 7200)
            end if
            do j = 1, np, nplm1 + 1
               k = min(j + nplm1, np)
               if (k == j) then
                  write (lunrpt, 8100) j, beta(j)
               else
                  write (lunrpt, 8200) j, k, (beta(l), l=j, k)
               end if
            end do
            if (niter >= 1) then
               write (lunrpt, 8800)
            else
               write (lunrpt, 8900)
            end if
         else
            write (lunrpt, 7500)
            do j = 1, np
               if (ifixb2(j) >= 1) then
                  write (lunrpt, 8500) j, beta(j), lower(j), upper(j)
               elseif (ifixb2(j) == 0) then
                  write (lunrpt, 8600) j, beta(j), lower(j), upper(j)
               else
                  write (lunrpt, 8700) j, beta(j), lower(j), upper(j)
               end if
            end do
         end if
      end if

      if (ipr == 1) return

      ! Print EPSILON's and DELTA's together in a column if the number of
      ! columns of data in EPSILON and DELTA is less than or equal to three.
      if (implicit .and. &
          (m <= 4)) then
         write (lunrpt, 4100)
         write (fmt1, 9110) m
         write (lunrpt, fmt1) (j, j=1, m)
         do i = 1, n
            write (lunrpt, 4130) i, (delta(i, j), j=1, m)
         end do

      elseif (isodr .and. &
              (q + m <= 4)) then
         write (lunrpt, 4110)
         write (fmt1, 9120) q, m
         write (lunrpt, fmt1) (l, l=1, q), (j, j=1, m)
         do i = 1, n
            write (lunrpt, 4130) i, (f(i, l), l=1, q), (delta(i, j), j=1, m)
         end do

      elseif (.not. isodr .and. &
              ((q >= 2) .and. &
               (q <= 4))) then
         write (lunrpt, 4120)
         write (fmt1, 9130) q
         write (lunrpt, fmt1) (l, l=1, q)
         do i = 1, n
            write (lunrpt, 4130) i, (f(i, l), l=1, q)
         end do
      else

         ! Print EPSILON's and DELTA's separately
         if (.not. implicit) then

            ! Print EPSILON'S
            do j = 1, q
               write (lunrpt, 4200) j
               if (n == 1) then
                  write (lunrpt, 7100)
               else
                  write (lunrpt, 7200)
               end if
               do i = 1, n, nplm1 + 1
                  k = min(i + nplm1, n)
                  if (i == k) then
                     write (lunrpt, 8100) i, f(i, j)
                  else
                     write (lunrpt, 8200) i, k, (f(l, j), l=i, k)
                  end if
               end do
            end do
         end if

         ! Print DELTA'S
         if (isodr) then
            do j = 1, m
               write (lunrpt, 4300) j
               if (n == 1) then
                  write (lunrpt, 7100)
               else
                  write (lunrpt, 7200)
               end if
               do i = 1, n, nplm1 + 1
                  k = min(i + nplm1, n)
                  if (i == k) then
                     write (lunrpt, 8100) i, delta(i, j)
                  else
                     write (lunrpt, 8200) i, k, (delta(l, j), l=i, k)
                  end if
               end do
            end do
         end if
      end if

      ! Format statements

1000  format &
         (/' --- Stopping Conditions:')
1011  format &
         ('         INFO = ', I5, ' ==> sum of squares convergence.')
1012  format &
         ('         INFO = ', I5, ' ==> parameter convergence.')
1013  format &
         ('         INFO = ', I5, ' ==> sum of squares convergence and', &
          ' parameter convergence.')
1014  format &
         ('         INFO = ', I5, ' ==> iteration limit reached.')
1015  format &
         ('         INFO = ', I5, ' ==> unexpected value,', &
          ' probably indicating'/ &
          '                           incorrectly specified', &
          ' user input.')
1020  format &
         ('         INFO = ', I5.4/ &
          '              =  ABCD, where a nonzero value for digit A,', &
          ' B, or C indicates why'/ &
          '                       the results might be questionable,', &
          ' and digit D indicates'/ &
          '                       the actual stopping condition.')
1021  format &
         ('                       A=1 ==> derivatives are', &
          ' questionable.')
1022  format &
         ('                       B=1 ==> user set ISTOP to', &
          ' nonzero value during last'/ &
          '                               call to subroutine FCN.')
1023  format &
         ('                       C=1 ==> derivatives are not', &
          ' full rank at the solution.')
1024  format &
         ('                       C=2 ==> derivatives are zero', &
          ' rank at the solution.')
1031  format &
         ('                       D=1 ==> sum of squares convergence.')
1032  format &
         ('                       D=2 ==> parameter convergence.')
1033  format &
         ('                       D=3 ==> sum of squares convergence', &
          ' and parameter convergence.')
1034  format &
         ('                       D=4 ==> iteration limit reached.')
1035  format &
         ('                       D=', I1, ' ==> unexpected value,', &
          ' probably indicating'/ &
          '                               incorrectly specified', &
          ' user input.')
1040  format &
         ('         INFO = ', I5.5/ &
          '              = ABCDE, where a nonzero value for a given', &
          ' digit indicates an'/ &
          '                       abnormal stopping condition.')
1042  format &
         ('                       A=5 ==> user stopped computations', &
          ' in subroutine FCN.')
1043  format &
         ('                       B=', I1, ' ==> computations were', &
          ' stopped during the'/ &
          '                                    function evaluation.')
1044  format &
         ('                       C=', I1, ' ==> computations were', &
          ' stopped because'/ &
          '                                    derivatives with', &
          ' respect to delta were'/ &
          '                                    computed by', &
          ' subroutine FCN when'/ &
          '                                    fit is OLS.')
1045  format &
         ('                       C=', I1, ' ==> computations were', &
          ' stopped during the'/ &
          '                                    jacobian evaluation.')
1050  format &
         ('                       A=6 ==> numerical instabilities', &
          ' have been detected,'/ &
          '                               possibly indicating', &
          ' a discontinuity in the'/ &
          '                               derivatives or a poor', &
          ' poor choice of problem'/ &
          '                               scale or weights.')
1060  format &
         ('                       A=', I1, ' ==> unexpected value,', &
          ' probably indicating'/ &
          '                               incorrectly specified', &
          ' user input.')
1300  format &
         ('        NITER = ', I5, &
          '          (number of iterations)')
1310  format &
         ('         NFEV = ', I5, &
          '          (number of function evaluations)')
1320  format &
         ('         NJEV = ', I5, &
          '          (number of jacobian evaluations)')
1330  format &
         ('        IRANK = ', I5, &
          '          (rank deficiency)')
1340  format &
         ('        RCOND = ', 1P, E12.2, &
          '   (inverse condition number)')
      !1341 FORMAT
      !       +  ('                      ==> POSSIBLY FEWER THAN 2 SIGNIFICANT',
      !       +                        ' DIGITS IN RESULTS;'/
      !       +   '                          SEE ODRPACK95 REFERENCE',
      !       +                        ' GUIDE, SECTION 4.C.')
1350  format &
         ('        ISTOP = ', I5, &
          '          (returned by user from', &
          ' subroutine FCN)')
2000  format &
         (/' --- Final Sum of Squared Weighted Deltas = ', &
           17X, 1P, E17.8)
2010  format &
         ('         Final Penalty Function Value     = ', 1P, E17.8/ &
          '               Penalty Term               = ', 1P, E17.8/ &
          '               Penalty Parameter          = ', 1P, E10.1)
2100  format &
         (/' --- Final Weighted Sums of Squares       = ', 1P, E17.8)
2110  format &
         ('         Sum of Squared Weighted Deltas   = ', 1P, E17.8/ &
          '         Sum of Squared Weighted Epsilons = ', 1P, E17.8)
2200  format &
         (/' --- Residual Standard Deviation          = ', 1P, E17.8/ &
           '         Degrees of Freedom               =', I5)
3000  format &
         (/' --- Estimated BETA(J), J = 1, ..., NP:')
4100  format &
         (/' --- Estimated DELTA(I,*), I = 1, ..., N:')
4110  format &
         (/' --- Estimated EPSILON(I) and DELTA(I,*), I = 1, ..., N:')
4120  format &
         (/' --- Estimated EPSILON(I), I = 1, ..., N:')
4130  format(5X, I5, 1P, 5E16.8)
4200  format &
         (/' --- Estimated EPSILON(I,', I3, '), I = 1, ..., N:')
4300  format &
         (/' --- Estimated DELTA(I,', I3, '), I = 1, ..., N:')
7100  format &
         (/'           Index           Value'/)
7200  format &
         (/'           Index           Value -------------->'/)
7300  format &
         (/'                     BETA      LOWER     UPPER      S.D. ', &
           ' ___ 95% Confidence ___'/ &
           '                                                    BETA ', &
           '        Interval'/)
7310  format &
         (/'     N.B. standard errors and confidence intervals are', &
           ' computed using'/ &
           '          derivatives calculated at the beginning', &
           ' of the last iteration,'/ &
           '          and not using derivatives re-evaluated at the', &
           ' final solution.')
7410  format &
         (/'     N.B. the standard errors of the estimated betas were', &
           ' not computed because'/ &
           '          the derivatives were not available.  Either MAXIT', &
           ' is 0 and the third'/ &
           '          digit of JOB is greater than 1, or the most', &
           ' recently tried values of'/ &
           '          BETA and/or X+DELTA were identified as', &
           ' unacceptable by user supplied'/ &
           '          subroutine FCN.')
7420  format &
         (/'     N.B. the standard errors of the estimated betas were', &
           ' not computed.'/ &
           '          (see info above.)')
7500  format &
         (/'                     BETA         Status')
8100  format &
         (11X, I5, 1P, E16.8)
8200  format &
         (3X, I5, ' to', I5, 1P, 7E16.8)
8400  format &
         (3X, I5, 1X, 1P, E16.8, 1X, E10.2, E10.2, E10.2, 1X, E10.2, 1X, 'to', E10.2)
8500  format &
         (3X, I5, 1X, 1P, E16.8, 1X, E10.2, E10.2, 4X, 'Estimated')
8600  format &
         (3X, I5, 1X, 1P, E16.8, 1X, E10.2, E10.2, 4X, '    Fixed')
8700  format &
         (3X, I5, 1X, 1P, E16.8, 1X, E10.2, E10.2, 4X, '  Dropped')
8800  format &
         (/'     N.B. no parameters were fixed by the user or', &
           ' dropped at the last'/ &
           '          iteration because they caused the model to be', &
           ' rank deficient.')
8900  format &
         (/'     N.B. no change was made to the user supplied parameter', &
           ' values because'/ &
           '          MAXIT=0.')
9110  format &
         ('(/''         I'',', &
          I2, '(''      DELTA(I,'',I1,'')'')/)')
9120  format &
         ('(/''         I'',', &
          I2, '(''    EPSILON(I,'',I1,'')''),', &
          I2, '(''      DELTA(I,'',I1,'')'')/)')
9130  format &
         ('(/''         I'',', &
          I2, '(''    EPSILON(I,'',I1,'')'')/)')

   end subroutine print_report_final