print_errors Subroutine

   impure subroutine print_errors &
      (info, lunerr, &
       n, m, np, q, &
       ldscld, ldstpd, ldwe, ld2we, ldwd, ld2wd, &
       lrwkmin, liwkmin, &
       fjacb, fjacd, &
       diff, msgb, isodr, msgd, &
       xplusd, nrow, neta, ntol)
   !! Controlling routine for printing error reports.

      integer, intent(inout) :: info
         !! Variable designating why the computations were stopped.
      integer, intent(in) :: lunerr
         !! Logical unit number used for error messages.
      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) :: ldscld
         !! Leading dimension of array `scld`.
      integer, intent(in) :: ldstpd
         !! Leading dimension of array `stpd`.
      integer, intent(in) :: ldwe
         !! Leading dimension of array `we`.
      integer, intent(in) :: ld2we
         !! Second dimension of array `we`.
      integer, intent(in) :: ldwd
         !! Leading dimension of array `wd`.
      integer, intent(in) :: ld2wd
         !! Second dimension of array `wd`.
      integer, intent(in) :: lrwkmin
         !! Minimum acceptable length of array `rwork`.
      integer, intent(in) :: liwkmin
         !! Minimum acceptable length of array `iwork`.
      real(wp), intent(in) :: fjacb(n, np, q)
         !! Jacobian with respect to `beta`.
      real(wp), intent(in) :: fjacd(n, m, q)
         !! Jacobian with respect to `delta`.
      real(wp), intent(in) :: diff(q, np + m)
         !! Relative differences between the user-supplied and finite difference
         !! derivatives for each derivative checked.
      integer, intent(in) :: msgb(q*np + 1)
         !! Error checking results for the Jacobian with respect to `beta`.
      logical, intent(in) :: isodr
         !! Variable designating whether the solution is by ODR (`isodr = .true.`) or
         !! by OLS (`isodr = .false.`).
      integer, intent(in) :: msgd(q*m + 1)
         !! Error checking results for the Jacobian with respect to `delta`.
      real(wp), intent(in) :: xplusd(n, m)
         !! Values `x + delta`.
      integer, intent(in) :: nrow
         !! Row number of the explanatory variable array at which the derivative is to be
         !! checked.
      integer, intent(in) :: neta
         !! Number of reliable digits in the model.
      integer, intent(in) :: ntol
         !! Number of digits of agreement required between the finite difference and the
         !! user-supplied derivatives.

      ! Local scalars
      integer :: d1, d2, d3, d4, d5
      logical :: head

      ! Variable Definitions (alphabetically)
      !  D1:      The 1st digit (from the left) of INFO.
      !  D2:      The 2nd digit (from the left) of INFO.
      !  D3:      The 3rd digit (from the left) of INFO.
      !  D4:      The 4th digit (from the left) of INFO.
      !  D5:      The 5th digit (from the left) of INFO.
      !  HEAD:    The variable designating whether the heading is to be printed (HEAD=.TRUE.)
      !           or not (HEAD=.FALSE.).

      ! Print heading
      head = .true.
      call print_header(head, lunerr)

      ! Extract individual digits from variable INFO
      d1 = mod(info, 100000)/10000
      d2 = mod(info, 10000)/1000
      d3 = mod(info, 1000)/100
      d4 = mod(info, 100)/10
      d5 = mod(info, 10)

      ! Print appropriate error messages for ODRPACK invoked stop
      if ((d1 >= 1 .and. d1 <= 3) .or. (d1 == 7 .or. d1 == 9)) then

         ! Print appropriate messages for errors in
         !         problem specification parameters
         !         dimension specification parameters
         !         number of good digits in X
         !         weights
         call print_error_inputs(lunerr, info, d1, d2, d3, d4, d5, &
                                 n, m, q, &
                                 ldscld, ldstpd, ldwe, ld2we, ldwd, ld2wd, &
                                 lrwkmin, liwkmin)

      elseif ((d1 == 4) .or. (msgb(1) >= 0)) then

         ! Print appropriate messages for derivative checking
         call print_error_derivative(lunerr, &
                                     n, m, np, q, &
                                     fjacb, fjacd, &
                                     diff, msgb(1), msgb(2), isodr, msgd(1), msgd(2), &
                                     xplusd, nrow, neta, ntol)

      elseif (d1 == 5) then

         ! Print appropriate error message for user invoked stop from FCN
         call print_error_fcn(lunerr, d2, d3)

      end if

      ! Print correct form of call statement
      if ((d1 >= 1 .and. d1 <= 3) .or. &
          (d1 == 4 .and. (d2 == 2 .or. d3 == 2)) .or. &
          (d1 == 5)) then
         write (lunerr, 1100)
      end if

      ! Format statements

1100  format &
         (//' The correct form of the call statement is '// &
           '       call odr'/ &
           '      +     (fcn,'/ &
           '      +     n, m, q, np,'/ &
           '      +     beta,'/ &
           '      +     y, x,'/ &
           '      +     delta*,'/ &
           '      +     we*, wd*,'/ &
           '      +     ifixb*, ifixx*,'/ &
           '      +     job*, ndigit*, taufac*,'/ &
           '      +     sstol*, partol*, maxit*,'/ &
           '      +     iprint*, lunerr*, lunrpt*,'/ &
           '      +     stpb*, stpd*,'/ &
           '      +     sclb*, scld*,'/ &
           '      +     rwork*, iwork*,'/ &
           '      +     info*,'/ &
           '      +     lower*, upper*)'/ &
           ' * optional argument')

   end subroutine print_errors