dodpc1 Subroutine

   impure subroutine dodpc1 &
      (ipr, lunrpt, &
      anajac, cdjac, chkjac, initd, restrt, isodr, implct, dovcv, redoj, &
      msgb1, msgb, msgd1, msgd, &
      n, m, np, nq, npp, nnzw, &
      x, ldx, ifixx, ldifx, delta, wd, ldwd, ld2wd, tt, ldtt, stpd, ldstpd &
      , y, ldy, we, ldwe, ld2we, pnlty, beta, ifixb, ssf, stpb, lower, &
      upper, job, neta, taufac, sstol, partol, maxit, wss, wssdel, wsseps)
   !! Generate initial summary report.
   ! Routines Called  DHSTEP
   ! Date Written   860529   (YYMMDD)
   ! Revision Date  920619   (YYMMDD)

      use odrpack_kinds, only: zero
      use odrpack_core, only: dhstep

      integer, intent(in) :: ipr
         !! The value indicating the report to be printed.
      integer, intent(in) :: lunrpt
         !! The logical unit number for the computation reports.
      logical, intent(in) :: anajac
         !! The variable designating whether the Jacobians are computed by finite differences
         !! (`anajac = .false.`) or not (`anajac = .true.`).
      logical, intent(in) :: cdjac
         !! The variable designating whether the Jacobians are computed by central differences
         !! (`cdjac = .true.`) or forward differences (`cdjac = .false.`).
      logical, intent(in) :: chkjac
         !! The variable designating whether the user-supplied Jacobians are to be checked
         !! (`chkjac = .true.`) or not (`chkjac = .false.`).
      logical, intent(in) :: initd
         !! The variable designating whether `delta` is initialized to zero (`initd = .true.`) 
         !! or to the values in the first `n` by `m` elements of array `work` (`initd = .false.`).
      logical, intent(in) :: restrt
         !! The variable designating whether the call is a restart (`restrt = .true.`) or
         !! not (`restrt = .false.`).
      logical, intent(in) :: isodr
         !! The variable designating whether the solution is by ODR (`isodr = .true.`) or
         !! by OLS (`isodr = .false.`).
      logical, intent(in) :: implct
         !! The variable designating whether the solution is by implicit ODR (`implct = .true.`)
         !! or explicit ODR (`implct = .false.`).
      logical, intent(in) :: dovcv
         !! The variable designating whether the covariance matrix is to be computed
         !! (`dovcv = .true.`) or not (`dovcv = .false.`).
      logical, intent(in) :: redoj
         !! The variable designating whether the Jacobian matrix is to be recomputed for the
         !! computation of the covariance matrix (`redoj = .true.`) or not (`redoj = .false.`).
      integer, intent(in) :: msgb1
         !! The error checking results for the Jacobian with respect to `beta`.
      integer, intent(in) :: msgb(nq, np)
         !! The error checking results for the Jacobian with respect to `beta`.
      integer, intent(in) :: msgd1
         !! The error checking results for the Jacobian with respect to `delta`.
      integer, intent(in) :: msgd(nq, m)
         !! The error checking results for the Jacobian with respect to `delta`.
      integer, intent(in) :: n
         !! The number of observations.
      integer, intent(in) :: m
         !! The number of columns of data in the explanatory variable.
      integer, intent(in) :: np
         !! The number of function parameters.
      integer, intent(in) :: nq
         !! The number of responses per observation.
      integer, intent(in) :: npp
         !! The number of function parameters being estimated.
      integer, intent(in) :: nnzw
         !! The number of nonzero observational error weights.
      real(wp), intent(in) :: x(ldx, m)
         !! The explanatory variable.
      integer, intent(in) :: ldx
         !! The leading dimension of array `x`.
      integer, intent(in) :: ifixx(ldifx, m)
         !! The values designating whether the elements of `x` are fixed at their input values or not.
      integer, intent(in) :: ldifx
         !! The leading dimension of array `ifixx`.
      real(wp), intent(in) :: delta(n, m)
         !! The estimated errors in the explanatory variables.
      real(wp), intent(in) :: wd(ldwd, ld2wd, m)
         !! The `delta` weights.
      integer, intent(in) :: ldwd
         !! The leading dimension of array `wd`.
      integer, intent(in) :: ld2wd
         !! The second dimension of array `wd`.
      real(wp), intent(in) :: tt(ldtt, m)
         !! The scaling values for `delta`.
      integer, intent(in) :: ldtt
         !! The leading dimension of array `tt`.
      real(wp), intent(in) :: stpd(ldstpd, m)
         !! The relative step used for computing finite difference derivatives with respect to `delta`.
      integer, intent(in) :: ldstpd
         !! The leading dimension of array `stpd`.
      real(wp), intent(in) :: y(ldy, nq)
         !! The response variable. Unused when the model is implicit.
      integer, intent(in) :: ldy
         !! The leading dimension of array `y`.
      real(wp), intent(in) :: we(ldwe, ld2we, nq)
         !! The `epsilon` weights.
      integer, intent(in) :: ldwe
         !! The leading dimension of array `we`.
      integer, intent(in) :: ld2we
         !! The second dimension of array `we`.
      real(wp), intent(in) :: pnlty
         !! The penalty parameter for an implicit model.
      real(wp), intent(in) :: beta(np)
         !! The function parameters.
      integer, intent(in) :: ifixb(np)
         !! The values designating whether the elements of `beta` are fixed at their input values
         !! or not.
      real(wp), intent(in) :: ssf(np)
         !! The scaling values for `beta`.
      real(wp), intent(in) :: stpb(np)
         !! The relative step used for computing finite difference derivatives with respect to `beta`.
      real(wp), intent(in) :: lower(np)
         !! The lower bounds for `beta`.
      real(wp), intent(in) :: upper(np)
         !! The upper bounds for `beta`.
      integer, intent(in) :: job
         !! The variable controlling problem initialization and computational method.
      integer, intent(in) :: neta
         !! The number of accurate digits in the function results. A negative value indicates
         !! that `neta` was estimated by 'odrpack'. A positive value indicates the value was
         !! supplied by the user.
      real(wp), intent(in) :: taufac
         !! The factor used to compute the initial trust region diameter.
      real(wp), intent(in) :: sstol
         !! The sum-of-squares convergence stopping tolerance.
      real(wp), intent(in) :: partol
         !! The parameter convergence stopping tolerance.
      integer, intent(in) :: maxit
         !! The maximum number of iterations allowed.
      real(wp), intent(in) :: wss
         !! The sum-of-squares of the weighted `epsilon`s and `delta`s.
      real(wp), intent(in) :: wssdel
         !! The sum-of-squares of the weighted `delta`s.
      real(wp), intent(in) :: wsseps
         !! The sum-of-squares of the weighted `epsilon`s.

      ! Local scalars
      real(wp) :: temp1, temp2, temp3
      integer :: i, itemp, j, job1, job2, job3, job4, job5, l

      ! Local arrays
      character(len=2) :: tempc0
      character(len=5) :: tempc1
      character(len=13) :: tempc2

      ! Variable Definitions (alphabetically)
      !  ANAJAC:  The variable designating whether the Jacobians are computed by finite differences
      !           (ANAJAC=FALSE) or not (ANAJAC=TRUE).
      !  BETA:    The function parameters.
      !  CDJAC:   The variable designating whether the Jacobians are computed by central differences
      !           (CDJAC=TRUE) or forward differences (CDJAC=FALSE).
      !  CHKJAC:  The variable designating whether the user supplied Jacobians are to be checked
      !           (CHKJAC=TRUE) or not (CHKJAC=FALSE).
      !  DELTA:   The estimated errors in the explanatory variables.
      !  DOVCV:   The variable designating whether the covariance matrix is to be computed
      !           (DOVCV=TRUE) or not (DOVCV=FALSE).
      !  I:       An indexing variable.
      !  IFIXB:   The values designating whether the elements of BETA are fixed at their input
      !           values or not.
      !  IFIXX:   The values designating whether the elements of X are fixed at their input
      !           values or not.
      !  IMPLCT:  The variable designating whether the solution is by implicit ODR (IMPLCT=TRUE)
      !           or explicit ODR (IMPLCT=FALSE).
      !  INITD:   The variable designating whether DELTA is initialized to zero (INITD=TRUE) or
      !           to the values in the first N by M elements of array WORK (INITD=FALSE).
      !  IPR:     The value indicating the report to be printed.
      !  ISODR:   The variable designating whether the solution is by ODR (ISODR=TRUE) or by
      !           OLS (ISODR=FALSE).
      !  ITEMP:   A temporary integer value.
      !  J:       An indexing variable.
      !  JOB:     The variable controling problem initialization and computational method.
      !  JOB1:    The 1st digit (from the left) of variable JOB.
      !  JOB2:    The 2nd digit (from the left) of variable JOB.
      !  JOB3:    The 3rd digit (from the left) of variable JOB.
      !  JOB4:    The 4th digit (from the left) of variable JOB.
      !  JOB5:    The 5th digit (from the left) of variable JOB.
      !  L:       An indexing variable.
      !  LDIFX:   The leading dimension of array IFIXX.
      !  LDTT:    The leading dimension of array TT.
      !  LDWD:    The leading dimension of array WD.
      !  LDWE:    The leading dimension of array WE.
      !  LDX:     The leading dimension of array X.
      !  LDY:     The leading dimension of array Y.
      !  LD2WD:   The second dimension of array WD.
      !  LD2WE:   The second dimension of array WE.
      !  LUNRPT:  The logical unit number for the computation reports.
      !  M:       The number of columns of data in the explanatory variable.
      !  MAXIT:   The maximum number of iterations allowed.
      !  MSGB:    The error checking results for the Jacobian wrt beta.
      !  MSGB1:   The error checking results for the Jacobian wrt BETA.
      !  MSGD:    The error checking results for the Jacobian wrt DELTA.
      !  MSGD1:   The error checking results for the Jacobian wrt DELTA.
      !  N:       The number of observations.
      !  NETA:    The number of accurate digits in the function results. A negative value
      !           indicates that NETA was estimated by ODRPACK. A positive value indictes the
      !           value was supplied by the user.
      !  NNZW:    The number of nonzero observational error weights.
      !  NP:      The number of function parameters.
      !  NPP:     The number of function parameters being estimated.
      !  NQ:      The number of responses per observation.
      !  PARTOL:  The parameter convergence stopping tolerance.
      !  PNLTY:   The penalty parameter for an implicit model.
      !  REDOJ:   The variable designating whether the Jacobian matrix is to be recomputed for 
      !           the computation of the covariance matrix (REDOJ=TRUE) or not (REDOJ=FALSE).
      !  RESTRT:  The variable designating whether the call is a restart (RESTRT=TRUE) or
      !           not (RESTRT=FALSE).
      !  SSF:     The scaling values for BETA.
      !  SSTOL:   The sum-of-squares convergence stopping tolerance.
      !  STPB:    The relative step used for computing finite difference derivatives with respect
      !           to BETA.
      !  STPD:    The relative step used for computing finite difference derivatives with respect
      !           to DELTA.
      !  TAUFAC:  The factor used to compute the initial trust region diameter.
      !  TEMPC0:  A temporary CHARACTER*2 value.
      !  TEMPC1:  A temporary CHARACTER*5 value.
      !  TEMPC2:  A temporary CHARACTER*13 value.
      !  TEMP1:   A temporary REAL (wp) value.
      !  TEMP2:   A temporary REAL (wp) value.
      !  TEMP3:   A temporary REAL (wp) value.
      !  TT:      The scaling values for DELTA.
      !  WD:      The DELTA weights.
      !  WE:      The EPSILON weights.
      !  WSS:     The sum-of-squares of the weighted EPSILONS and DELTAS.
      !  WSSDEL:  The sum-of-squares of the weighted DELTAS.
      !  WSSEPS:  The sum-of-squares of the weighted EPSILONS.
      !  X:       The explanatory variable.
      !  Y:       The response variable.  Unused when the model is implicit.

      ! Print problem size specification
      write (lunrpt, 1000) n, nnzw, nq, m, np, npp

      ! Print control values
      job1 = job/10000
      job2 = mod(job, 10000)/1000
      job3 = mod(job, 1000)/100
      job4 = mod(job, 100)/10
      job5 = mod(job, 10)
      write (lunrpt, 1100) job
      if (restrt) then
         write (lunrpt, 1110) job1
      else
         write (lunrpt, 1111) job1
      end if
      if (isodr) then
         if (initd) then
            write (lunrpt, 1120) job2
         else
            write (lunrpt, 1121) job2
         end if
      else
         write (lunrpt, 1122) job2, job5
      end if
      if (dovcv) then
         write (lunrpt, 1130) job3
         if (redoj) then
            write (lunrpt, 1131)
         else
            write (lunrpt, 1132)
         end if
      else
         write (lunrpt, 1133) job3
      end if
      if (anajac) then
         write (lunrpt, 1140) job4
         if (chkjac) then
            if (msgb1 >= 1 .or. msgd1 >= 1) then
               write (lunrpt, 1141)
            else
               write (lunrpt, 1142)
            end if
         else
            write (lunrpt, 1143)
         end if
      elseif (cdjac) then
         write (lunrpt, 1144) job4
      else
         write (lunrpt, 1145) job4
      end if
      if (isodr) then
         if (implct) then
            write (lunrpt, 1150) job5
         else
            write (lunrpt, 1151) job5
         end if
      else
         write (lunrpt, 1152) job5
      end if
      if (neta < 0) then
         write (lunrpt, 1200) - neta
      else
         write (lunrpt, 1210) neta
      end if
      write (lunrpt, 1300) taufac

      ! Print stopping criteria
      write (lunrpt, 1400) sstol, partol, maxit

      ! Print initial sum of squares
      if (implct) then
         write (lunrpt, 1500) wssdel
         if (isodr) then
            write (lunrpt, 1510) wss, wsseps, pnlty
         end if
      else
         write (lunrpt, 1600) wss
         if (isodr) then
            write (lunrpt, 1610) wssdel, wsseps
         end if
      end if

      if (ipr >= 2) then

         ! Print function parameter data
         write (lunrpt, 4000)
         if (chkjac .and. &
            ((msgb1 >= 1) .or. &
            (msgd1 >= 1))) then
            write (lunrpt, 4110)
         elseif (anajac) then
            write (lunrpt, 4120)
         else
            write (lunrpt, 4200)
         end if
         do j = 1, np
            if (ifixb(1) < 0) then
               tempc1 = '   NO'
            else
               if (ifixb(j) /= 0) then
                  tempc1 = '   NO'
               else
                  tempc1 = '  YES'
               end if
            end if
            if (anajac) then
               if (chkjac .and. &
                  ((msgb1 >= 1) .or. &
                  (msgd1 >= 1))) then
                  itemp = -1
                  do l = 1, nq
                     itemp = max(itemp, msgb(l, j))
                  end do
                  if (itemp <= -1) then
                     tempc2 = '    UNCHECKED'
                  elseif (itemp == 0) then
                     tempc2 = '     VERIFIED'
                  elseif (itemp >= 1) then
                     tempc2 = ' QUESTIONABLE'
                  end if
               else
                  tempc2 = '             '
               end if
            else
               tempc2 = '             '
            end if
            if (ssf(1) < zero) then
               temp1 = abs(ssf(1))
            else
               temp1 = ssf(j)
            end if
            if (anajac) then
               write (lunrpt, 4310) j, beta(j), tempc1, temp1, lower(j), &
                  upper(j), tempc2
            else
               if (cdjac) then
                  temp2 = dhstep(1, neta, 1, j, stpb, 1)
               else
                  temp2 = dhstep(0, neta, 1, j, stpb, 1)
               end if
               write (lunrpt, 4320) j, beta(j), tempc1, temp1, &
                  lower(j), upper(j), temp2
            end if
         end do

         ! Print explanatory variable data
         if (isodr) then
            write (lunrpt, 2010)
            if (chkjac .and. &
               ((msgb1 >= 1) .or. &
               (msgd1 >= 1))) then
               write (lunrpt, 2110)
            elseif (anajac) then
               write (lunrpt, 2120)
            else
               write (lunrpt, 2130)
            end if
         else
            write (lunrpt, 2020)
            write (lunrpt, 2140)
         end if
         if (isodr) then
            do j = 1, m
               tempc0 = '1,'
               do i = 1, n, n - 1

                  if (ifixx(1, 1) < 0) then
                     tempc1 = '   NO'
                  else
                     if (ldifx == 1) then
                        if (ifixx(1, j) == 0) then
                           tempc1 = '  YES'
                        else
                           tempc1 = '   NO'
                        end if
                     else
                        if (ifixx(i, j) == 0) then
                           tempc1 = '  YES'
                        else
                           tempc1 = '   NO'
                        end if
                     end if
                  end if

                  if (tt(1, 1) < zero) then
                     temp1 = abs(tt(1, 1))
                  else
                     if (ldtt == 1) then
                        temp1 = tt(1, j)
                     else
                        temp1 = tt(i, j)
                     end if
                  end if

                  if (wd(1, 1, 1) < zero) then
                     temp2 = abs(wd(1, 1, 1))
                  else
                     if (ldwd == 1) then
                        if (ld2wd == 1) then
                           temp2 = wd(1, 1, j)
                        else
                           temp2 = wd(1, j, j)
                        end if
                     else
                        if (ld2wd == 1) then
                           temp2 = wd(i, 1, j)
                        else
                           temp2 = wd(i, j, j)
                        end if
                     end if
                  end if

                  if (anajac) then
                     if (chkjac .and. &
                        (((msgb1 >= 1) .or. &
                           (msgd1 >= 1)) .and. &
                        (i == 1))) then
                        itemp = -1
                        do l = 1, nq
                           itemp = max(itemp, msgd(l, j))
                        end do
                        if (itemp <= -1) then
                           tempc2 = '    UNCHECKED'
                        elseif (itemp == 0) then
                           tempc2 = '     VERIFIED'
                        elseif (itemp >= 1) then
                           tempc2 = ' QUESTIONABLE'
                        end if
                     else
                        tempc2 = '             '
                     end if
                     if (m <= 9) then
                        write (lunrpt, 5110) &
                           tempc0, j, x(i, j), &
                           delta(i, j), tempc1, temp1, temp2, tempc2
                     else
                        write (lunrpt, 5120) &
                           tempc0, j, x(i, j), &
                           delta(i, j), tempc1, temp1, temp2, tempc2
                     end if
                  else
                     tempc2 = '             '
                     if (cdjac) then
                        temp3 = dhstep(1, neta, i, j, stpd, ldstpd)
                     else
                        temp3 = dhstep(0, neta, i, j, stpd, ldstpd)
                     end if
                     if (m <= 9) then
                        write (lunrpt, 5210) &
                           tempc0, j, x(i, j), &
                           delta(i, j), tempc1, temp1, temp2, temp3
                     else
                        write (lunrpt, 5220) &
                           tempc0, j, x(i, j), &
                           delta(i, j), tempc1, temp1, temp2, temp3
                     end if
                  end if

                  tempc0 = 'N,'

               end do
               if (j < m) write (lunrpt, 6000)
            end do
         else

            do j = 1, m
               tempc0 = '1,'
               do i = 1, n, n - 1
                  if (m <= 9) then
                     write (lunrpt, 5110) &
                        tempc0, j, x(i, j)
                  else
                     write (lunrpt, 5120) &
                        tempc0, j, x(i, j)
                  end if
                  tempc0 = 'N,'
               end do
               if (j < m) write (lunrpt, 6000)
            end do
         end if

         ! Print response variable data and observation error weights
         if (.not. implct) then
            write (lunrpt, 3000)
            write (lunrpt, 3100)
            do l = 1, nq
               tempc0 = '1,'
               do i = 1, n, n - 1
                  if (we(1, 1, 1) < zero) then
                     temp1 = abs(we(1, 1, 1))
                  elseif (ldwe == 1) then
                     if (ld2we == 1) then
                        temp1 = we(1, 1, l)
                     else
                        temp1 = we(1, l, l)
                     end if
                  else
                     if (ld2we == 1) then
                        temp1 = we(i, 1, l)
                     else
                        temp1 = we(i, l, l)
                     end if
                  end if
                  if (nq <= 9) then
                     write (lunrpt, 5110) &
                        tempc0, l, y(i, l), temp1
                  else
                     write (lunrpt, 5120) &
                        tempc0, l, y(i, l), temp1
                  end if
                  tempc0 = 'N,'
               end do
               if (l < nq) write (lunrpt, 6000)
            end do
         end if
      end if

      ! Format statements

   1000 format &
         (/' --- Problem Size:'/ &
         '            N = ', I5, &
         '          (number with nonzero weight = ', I5, ')'/ &
         '           NQ = ', I5/ &
         '            M = ', I5/ &
         '           NP = ', I5, &
         '          (number unfixed = ', I5, ')')
   1100 format &
         (/' --- Control Values:'/ &
         '          JOB = ', I5.5/ &
         '              = ABCDE, where')
   1110 format &
         ('                       A=', I1, ' ==> fit is a restart.')
   1111 format &
         ('                       A=', I1, ' ==> fit is not a restart.')
   1120 format &
         ('                       B=', I1, ' ==> deltas are initialized', &
         ' to zero.')
   1121 format &
         ('                       B=', I1, ' ==> deltas are initialized', &
         ' by user.')
   1122 format &
         ('                       B=', I1, ' ==> deltas are fixed at', &
         ' zero since E=', I1, '.')
   1130 format &
         ('                       C=', I1, ' ==> covariance matrix will', &
         ' be computed using')
   1131 format &
         ('                               derivatives re-', &
         'evaluated at the solution.')
   1132 format &
         ('                               derivatives from the', &
         ' last iteration.')
   1133 format &
         ('                       C=', I1, ' ==> covariance matrix will', &
         ' not be computed.')
   1140 format &
         ('                       D=', I1, ' ==> derivatives are', &
         ' supplied by user.')
   1141 format &
         ('                               derivatives were checked.'/ &
         '                               results appear questionable.')
   1142 format &
         ('                               derivatives were checked.'/ &
         '                               results appear correct.')
   1143 format &
         ('                               derivatives were not', &
         ' checked.')
   1144 format &
         ('                       D=', I1, ' ==> derivatives are', &
         ' estimated by central', &
         ' differences.')
   1145 format &
         ('                       D=', I1, ' ==> derivatives are', &
         ' estimated by forward', &
         ' differences.')
   1150 format &
         ('                       E=', I1, ' ==> method is implicit ODR.')
   1151 format &
         ('                       E=', I1, ' ==> method is explicit ODR.')
   1152 format &
         ('                       E=', I1, ' ==> method is explicit OLS.')
   1200 format &
         ('       NDIGIT = ', I5, '          (estimated by ODRPACK)')
   1210 format &
         ('       NDIGIT = ', I5, '          (supplied by user)')
   1300 format &
         ('       TAUFAC = ', 1P, E12.2)
   1400 format &
         (/' --- Stopping Criteria:'/ &
         '        SSTOL = ', 1P, E12.2, &
         '   (sum of squares stopping tolerance)'/ &
         '       PARTOL = ', 1P, E12.2, &
         '   (parameter stopping tolerance)'/ &
         '        MAXIT = ', I5, &
         '          (maximum number of iterations)')
   1500 format &
         (/' --- Initial Sum of Squared Weighted Deltas =', &
         17X, 1P, E17.8)
   1510 format &
         ('         Initial Penalty Function Value     =', 1P, E17.8/ &
         '                 Penalty Term               =', 1P, E17.8/ &
         '                 Penalty Parameter          =', 1P, E10.1)
   1600 format &
         (/' --- Initial Weighted Sum of Squares        =', &
         17X, 1P, E17.8)
   1610 format &
         ('         Sum of Squared Weighted Deltas     =', 1P, E17.8/ &
         '         Sum of Squared Weighted Epsilons   =', 1P, E17.8)
   2010 format &
         (/' --- Explanatory Variable and Delta Weight Summary:')
   2020 format &
         (/' --- Explanatory Variable Summary:')
   2110 format &
         (/'       Index      X(I,J)  DELTA(I,J)    Fixed', &
         '     Scale    Weight    Derivative'/ &
         '                                             ', &
         '                        Assessment'/, &
         '       (I,J)                          (IFIXX)', &
         '    (SCLD)      (WD)              '/)
   2120 format &
         (/'       Index      X(I,J)  DELTA(I,J)    Fixed', &
         '     Scale    Weight              '/ &
         '                                             ', &
         '                                  '/, &
         '       (I,J)                          (IFIXX)', &
         '    (SCLD)      (WD)              '/)
   2130 format &
         (/'       Index      X(I,J)  DELTA(I,J)    Fixed', &
         '     Scale    Weight    Derivative'/ &
         '                                             ', &
         '                         Step Size'/, &
         '       (I,J)                          (IFIXX)', &
         '    (SCLD)      (WD)        (STPD)'/)
   2140 format &
         (/'       Index      X(I,J)'/ &
         '       (I,J)            '/)
   3000 format &
         (/' --- Response Variable and Epsilon Error Weight', &
         ' Summary:')
   3100 format &
         (/'       Index      Y(I,L)      Weight'/ &
         '       (I,L)                    (WE)'/)
   4000 format &
         (/' --- Function Parameter Summary:')
   4110 format &
         (/'       Index   BETA(K)    Fixed     Scale   LOWER(K)', &
         '   UPPER(K)    Derivative'/ &
         '                                                    ', &
         '               Assessment'/, &
         '         (K)            (IFIXB)    (SCLB)           ', &
         '                         '/)
   4120 format &
         (/'       Index   BETA(K)    Fixed     Scale   LOWER(K)', &
         '   UPPER(K)              '/ &
         '                                                    ', &
         '                         '/, &
         '         (K)            (IFIXB)    (SCLB)           ', &
         '                         '/)
   4200 format &
         (/'       Index   BETA(K)    Fixed     Scale   LOWER(K)', &
         '   UPPER(K)    Derivative'/ &
         '                                                    ', &
         '                Step Size'/, &
         '         (K)            (IFIXB)    (SCLB)           ', &
         '                   (STPB)'/)
   4310 format &
         (7X, I5, 1P, E10.2, 4X, A5, E10.2, E11.2E3, E11.2E3, 1X, A13)
   4320 format &
         (7X, I5, 1P, E10.2, 4X, A5, E10.2, E11.2E3, E11.2E3, 1X, E13.5)
   5110 format &
         (9X, A2, I1, 1P, 2E12.3, 4X, A5, 2E10.2, 1X, A13)
   5120 format &
         (8X, A2, I2, 1P, 2E12.3, 4X, A5, 2E10.2, 1X, A13)
   5210 format &
         (9X, A2, I1, 1P, 2E12.3, 4X, A5, 2E10.2, 1X, E13.5)
   5220 format &
         (8X, A2, I2, 1P, 2E12.3, 4X, A5, 2E10.2, 1X, E13.5)
   6000 format &
         (' ')
   end subroutine dodpc1