print_error_inputs Subroutine

   impure subroutine print_error_inputs &
      (lunerr, info, d1, d2, d3, d4, d5, &
       n, m, q, &
       ldscld, ldstpd, ldwe, ld2we, ldwd, ld2wd, &
       lrwkmin, liwkmin)
   !! Print error reports.

      integer, intent(in) :: lunerr
         !! Logical unit number used for error messages.
      integer, intent(inout) :: info
         !! Variable designating why the computations were stopped.
      integer, intent(in) :: d1
         !! 1st digit (from the left) of `info`.
      integer, intent(in) :: d2
         !! 2nd digit (from the left) of `info`.
      integer, intent(in) :: d3
         !! 3rd digit (from the left) of `info`.
      integer, intent(in) :: d4
         !! 4th digit (from the left) of `info`.
      integer, intent(in) :: d5
         !! 5th digit (from the left) of `info`.
      integer, intent(in) :: n
         !! Number of observations.
      integer, intent(in) :: m
         !! Number of columns of data in the explanatory variable.
      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`.

      ! Print appropriate messages for errors in problem specification parameters

      if (d1 == 1) then
         if (d2 /= 0) then
            write (lunerr, 1100)
         end if
         if (d3 /= 0) then
            write (lunerr, 1200)
         end if
         if (d4 /= 0) then
            write (lunerr, 1300)
         end if
         if (d5 /= 0) then
            write (lunerr, 1400)
         end if

         ! Print appropriate messages for errors in dimension specification parameters

      elseif (d1 == 2) then

         if (d2 /= 0) then
            if (d2 == 1 .or. d2 == 3) then
               write (lunerr, 2110)
            end if
            if (d2 == 2 .or. d2 == 3) then
               write (lunerr, 2120)
            end if
         end if

         if (d3 /= 0) then
            if (d3 == 1 .or. d3 == 3 .or. d3 == 5 .or. d3 == 7) &
               then
               write (lunerr, 2210)
            end if
            if (d3 == 2 .or. d3 == 3 .or. d3 == 6 .or. d3 == 7) &
               then
               write (lunerr, 2220)
            end if
            if (d3 == 4 .or. d3 == 5 .or. d3 == 6 .or. d3 == 7) &
               then
               write (lunerr, 2230)
            end if
         end if

         if (d4 /= 0) then
            if (d4 == 1 .or. d4 == 3) then
               write (lunerr, 2310)
            end if
            if (d4 == 2 .or. d4 == 3) then
               write (lunerr, 2320)
            end if
         end if

         if (d5 /= 0) then
            if (d5 == 1 .or. d5 == 3) then
               write (lunerr, 2410) lrwkmin
            end if
            if (d5 == 2 .or. d5 == 3) then
               write (lunerr, 2420) liwkmin
            end if
         end if

      elseif (d1 == 3) then

         ! Print appropriate messages for errors in scale values

         if (d3 /= 0) then
            if (d3 == 2 .or. d3 == 3) then
               if (ldscld >= n) then
                  write (lunerr, 3110)
               else
                  write (lunerr, 3120)
               end if
            end if
            if (d3 == 1 .or. d3 == 3) then
               write (lunerr, 3130)
            end if
         end if

         ! Print appropriate messages for errors in derivative step values

         if (d2 /= 0) then
            if (d2 == 2 .or. d2 == 3) then
               if (ldstpd >= n) then
                  write (lunerr, 3210)
               else
                  write (lunerr, 3220)
               end if
            end if
            if (d2 == 1 .or. d2 == 3) then
               write (lunerr, 3230)
            end if
         end if

         ! Print appropriate messages for errors in observational error weights

         if (d4 /= 0) then
            if (d4 == 1) then
               if (ldwe >= n) then
                  if (ld2we >= q) then
                     write (lunerr, 3310)
                  else
                     write (lunerr, 3320)
                  end if
               else
                  if (ld2we >= q) then
                     write (lunerr, 3410)
                  else
                     write (lunerr, 3420)
                  end if
               end if
            end if
            if (d4 == 2) then
               write (lunerr, 3500)
            end if
         end if

         ! Print appropriate messages for errors in DELTA weights

         if (d5 /= 0) then
            if (ldwd >= n) then
               if (ld2wd >= m) then
                  write (lunerr, 4310)
               else
                  write (lunerr, 4320)
               end if
            else
               if (ld2wd >= m) then
                  write (lunerr, 4410)
               else
                  write (lunerr, 4420)
               end if
            end if
         end if

      elseif (d1 == 7) then

         ! Print the appropriate messages for errors in JOB

         if (d2 /= 0) then
            write (lunerr, 5000)
         end if

         if (d3 /= 0) then
            write (lunerr, 5100)
         end if

         if (d4 /= 0) then
            write (lunerr, 5200)
         end if

      elseif (d1 == 8) then

         ! Print the appropriate messages for errors in array allocation

         if (d2 /= 0) then
            write (lunerr, 7200)
         end if

         if (d3 /= 0) then
            write (lunerr, 7300)
         end if

         if (d4 /= 0) then
            write (lunerr, 7400)
         end if

      elseif (d1 == 9) then

         ! Print the appropriate messages for errors in bounds

         if (d2 /= 0) then
            write (lunerr, 6000)
         end if

         if (d3 /= 0) then
            write (lunerr, 6100)
         end if

         if (d4 == 1) then
            write (lunerr, 6210)
         end if

         if (d4 == 2) then
            write (lunerr, 6220)
         end if

      end if

      ! Print error messages for array sizes incorrect

      if (info/100000 == 1) then
         info = info - 100000
         if (info >= 32768) then
            info = info - 32768
            write (lunerr, 8015)
         end if
         if (info >= 16384) then
            info = info - 16384
            write (lunerr, 8014)
         end if
         if (info >= 8192) then
            info = info - 8192
            write (lunerr, 8013)
         end if
         if (info >= 4096) then
            info = info - 4096
            write (lunerr, 8012)
         end if
         if (info >= 2048) then
            info = info - 2048
            write (lunerr, 8011)
         end if
         if (info >= 1024) then
            info = info - 1024
            write (lunerr, 8010)
         end if
         if (info >= 512) then
            info = info - 512
            write (lunerr, 8009)
         end if
         if (info >= 256) then
            info = info - 256
            write (lunerr, 8008)
         end if
         if (info >= 128) then
            info = info - 128
            write (lunerr, 8007)
         end if
         if (info >= 64) then
            info = info - 64
            write (lunerr, 8006)
         end if
         if (info >= 32) then
            info = info - 32
            write (lunerr, 8005)
         end if
         if (info >= 16) then
            info = info - 16
            write (lunerr, 8004)
         end if
         if (info >= 8) then
            info = info - 8
            write (lunerr, 8003)
         end if
         if (info >= 4) then
            info = info - 4
            write (lunerr, 8002)
         end if
         if (info >= 2) then
            info = info - 2
            write (lunerr, 8001)
         end if
         if (info >= 1) then
            info = info - 1
            write (lunerr, 8000)
         end if
         info = info + 100000
      end if

      ! Format statements

1100  format &
         (/' ERROR :  N is less than one.')
1200  format &
         (/' ERROR :  M is less than one.')
1300  format &
         (/' ERROR :  NP is less than one or NP is greater than N.')
1400  format &
         (/' ERROR :  Q is less than one.')
2110  format &
         (/' ERROR :  SIZE(X, 1) is different from N.')
2120  format &
         (/' ERROR :  SIZE(Y, 1) is different from N.')
2210  format &
         (/' ERROR :  LDIFX is less than N and LDIFX is not equal to one.')
2220  format &
         (/' ERROR :  LDSCLD is less than N and LDSCLD is not equal to one.')
2230  format &
         (/' ERROR :  LDSTPD is less than N and LDSTPD is not equal to one.')
2310  format &
         (/' ERROR :  LDWE is less than N and LDWE is not equal to one or'/ &
           '          or LD2WE is less than Q and LD2WE is not equal to one.')
2320  format &
         (/' ERROR :  LDWD is less than N and LDWD is not equal to one.')
2410  format &
         (/' ERROR :  LRWORK is less than ', I7, ','/ &
           '          the smallest acceptable dimension of array RWORK.')
2420  format &
         (/' ERROR :  LIWORK is less than ', I7, ','/ &
           '          the smallest acceptable dimension of array IWORK.')
3110  format &
         (/' ERROR :  SCLD(I,J) <= 0 for some I = 1, ..., N and J = 1, ..., M.'/ &
           '          When SCLD(1,1) > 0 and LDSCLD = N then each of'/ &
           '          the N by M elements of SCLD must be greater than zero.')
3120  format &
         (/' ERROR :  SCLD(1,J) <= 0 for some J = 1, ..., M.'/ &
           '          When SCLD(1,1) > 0 and LDSCLD = 1 then each of'/ &
           '          the 1 by M elements of SCLD must be greater than zero.')
3130  format &
         (/' ERROR :  SCLB(K) <= 0 for some K = 1, ..., NP.'/ &
           '          All NP elements of SCLB must be greater than zero.')
3210  format &
         (/' ERROR :  STPD(I,J) < = 0 for some I = 1, ..., N and J = 1, ..., M.'/ &
           '          When STPD(1,1) > 0 and LDSTPD = N then each of'/ &
           '          the N by M elements of STPD must be greater than zero.')
3220  format &
         (/' ERROR :  STPD(1,J) <= 0 for some J = 1, ..., M.'/ &
           '          When STPD(1,1) > 0 and LDSTPD = 1 then each of'/ &
           '          the 1 by M elements of STPD must be greater than zero.')
3230  format &
         (/' ERROR :  STPB(K) <= 0 for some K = 1, ..., NP.'/ &
           '          All NP elements of STPB must be greater than zero.')
3310  format &
         (/' ERROR :  At least one of the (Q by Q) arrays starting'/ &
           '          in WE(I,1,1), I = 1, ..., N, is not positive semidefinite.'/ &
           '          When WE(1,1,1) >= 0 and LDWE = N and LD2WE = Q, then each of'/ &
           '          the (Q by Q) arrays in WE must be positive semidefinite.')
3320  format &
         (/' ERROR :  At least one of the (1 by Q) arrays starting'/ &
           '          in WE(I,1,1), I = 1, ..., N, has a negative element.'/ &
           '          When WE(1,1,1) >= 0 and LDWE = N and LD2WE = 1, then each of'/ &
           '          the (1 by Q) arrays in WE must have only non-negative elements.')
3410  format &
         (/' ERROR :  The (Q by Q) array starting in WE(1,1,1) is not positive semidefinite.'/ &
           '          When WE(1,1,1) >= 0 and LDWE = 1 and LD2WE = Q, then'/ &
           '          the (Q by Q) array in WE must be positive semidefinite.')
3420  format &
         (/' ERROR :  The (1 by Q) array starting in WE(1,1,1) has a negative element.'/ &
           '          When WE(1,1,1) >= 0 and LDWE = 1 and LD2WE = 1, then'/ &
           '          the (1 by Q) array in WE must have only nonnegative elements.')
3500  format &
         (/' ERROR :  The number of nonzero arrays in array WE is less than NP.')
4310  format &
         (/' ERROR :  At least one of the (M by M) arrays starting'/ &
           '          in WD(I,1,1), I = 1, ..., N, is not positive definite.'/ &
           '          When WD(1,1,1) >= 0 and LDWD = N and LD2WD = M, then each of'/ &
           '          the (M by M) arrays in WD must be positive definite.')
4320  format &
         (/' ERROR :  At least one of the (1 by M) arrays starting'/ &
           '          in WD(I,1,1), I = 1, ..., N, has a nonpositive element.'/ &
           '          When WD(1,1,1) >= 0 and LDWD = N and LD2WD = 1, then each of'/ &
           '          the (1 by M) arrays in WD must have only positive elements.')
4410  format &
         (/' ERROR :  The (M by M) array starting in WD(1,1,1) is not positive definite.'/ &
           '          When WD(1,1,1) >= 0 and LDWD = 1 and LD2WD = M, then the'/ &
           '          (M by M) array in WD must be positive definite.')
4420  format &
         (/' ERROR :  The (1 by M) array starting in WD(1,1,1) has a nonpositive element.'/ &
           '          When WD(1,1,1) >= 0 and LDWD = 1 and LD2WD = 1, then'/ &
           '          the (1 by M) array in WD must have only positive elements.')
5000  format &
         (/' ERROR :  JOB requires the optional argument DELTA and DELTA is not present.')
5100  format &
         (/' ERROR :  JOB requires the optional argument RWORK and RWORK is not present.')
5200  format &
         (/' ERROR :  JOB requires the optional argument IWORK and IWORK is not present.')
6000  format &
         (/' ERROR :  LOWER(K) > UPPER(K) for some K.'/ &
           '          Adjust the bounds so that LOWER(K) <= UPPER(K) holds for all K.')
6100  format &
         (/' ERROR :  BETA(K) > UPPER(K) or BETA(K) < LOWER(K) for some K.'/ &
           '          Adjust the bounds or BETA so that LOWER(K) <= BETA(K) <= UPPER(K)'/ &
           '          holds for all K.')
6210  format &
         (/' ERROR :  UPPER(K)-LOWER(K) < 400*BETA(K)*EPSMAC for some K and EPSMAC having'/ &
           '          the largest value such that 1+EPSMAC/=1.'/ &
           '          This constraint on UPPER and LOWER is necessary for the calculation'/ &
           '          of NDIGIT. Widen the bounds or specify NDIGIT explicitly.')
6220  format &
         (/' ERROR :  UPPER(K)-LOWER(K) < ABS(STEP) for some K where STEP is the step size'/ &
           '          for numeric derivatives.'/ &
           '          Widen the bounds or supply an analytic jacobian.')
7200  format &
         (/' ERROR :  DELTA could not be allocated. ')
7300  format &
         (/' ERROR :  RWORK could not be allocated. ')
7400  format &
         (/' ERROR :  IWORK could not be allocated. ')
8000  format &
         (/' ERROR :  BETA has incorrect size. ')
8001  format &
         (/' ERROR :  Y has incorrect shape. ')
8002  format &
         (/' ERROR :  X has incorrect shape. ')
8003  format &
         (/' ERROR :  DELTA has incorrect shape. ')
8004  format &
         (/' ERROR :  WE has incorrect shape. ')
8005  format &
         (/' ERROR :  WD has incorrect shape. ')
8006  format &
         (/' ERROR :  IFIXB has incorrect size. ')
8007  format &
         (/' ERROR :  IFIXX has incorrect shape. ')
8008  format &
         (/' ERROR :  STPB has incorrect size. ')
8009  format &
         (/' ERROR :  STPD has incorrect shape. ')
8010  format &
         (/' ERROR :  SCLB has incorrect size. ')
8011  format &
         (/' ERROR :  SCLD has incorrect shape. ')
8012  format &
         (/' ERROR :  RWORK has incorrect size. ')
8013  format &
         (/' ERROR :  IWORK has incorrect size. ')
8014  format &
         (/' ERROR :  UPPER has incorrect size. ')
8015  format &
         (/' ERROR :  LOWER has incorrect size. ')

   end subroutine print_error_inputs