dodpe1 Subroutine

public impure subroutine dodpe1(lunerr, info, d1, d2, d3, d4, d5, n, m, nq, ldscld, ldstpd, ldwe, ld2we, ldwd, ld2wd, lwkmn, liwkmn)

Print error reports.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: lunerr

The logical unit number used for error messages.

integer, intent(inout) :: info

The variable designating why the computations were stopped.

integer, intent(in) :: d1

The 1st digit (from the left) of info.

integer, intent(in) :: d2

The 2nd digit (from the left) of info.

integer, intent(in) :: d3

The 3rd digit (from the left) of info.

integer, intent(in) :: d4

The 4th digit (from the left) of info.

integer, intent(in) :: d5

The 5th digit (from the left) of info.

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) :: nq

The number of responses per observation.

integer, intent(in) :: ldscld

The leading dimension of array scld.

integer, intent(in) :: ldstpd

The leading dimension of array stpd.

integer, intent(in) :: ldwe

The leading dimension of array we.

integer, intent(in) :: ld2we

The second dimension of array we.

integer, intent(in) :: ldwd

The leading dimension of array wd.

integer, intent(in) :: ld2wd

The second dimension of array wd.

integer, intent(in) :: lwkmn

The minimum acceptable length of array work.

integer, intent(in) :: liwkmn

The minimum acceptable length of array iwork.


Called by

proc~~dodpe1~~CalledByGraph proc~dodpe1 dodpe1 proc~dodper dodper proc~dodper->proc~dodpe1 proc~odr odr proc~odr->proc~dodpe1 proc~dodcnt dodcnt proc~odr->proc~dodcnt proc~doddrv doddrv proc~doddrv->proc~dodper proc~odr_long_c odr_long_c proc~odr_long_c->proc~odr proc~odr_medium_c odr_medium_c proc~odr_medium_c->proc~odr proc~odr_short_c odr_short_c proc~odr_short_c->proc~odr program~example1 example1 program~example1->proc~odr program~example2 example2 program~example2->proc~odr program~example3 example3 program~example3->proc~odr program~example4 example4 program~example4->proc~odr program~example5 example5 program~example5->proc~odr proc~dodcnt->proc~doddrv

Source Code

   impure subroutine dodpe1 &
      (lunerr, info, d1, d2, d3, d4, d5, &
       n, m, nq, &
       ldscld, ldstpd, ldwe, ld2we, ldwd, ld2wd, &
       lwkmn, liwkmn)
   !! Print error reports.
      ! Routines Called  (NONE)
      ! Date Written   860529   (YYMMDD)
      ! Revision Date  920619   (YYMMDD)

      integer, intent(in) :: lunerr
         !! The logical unit number used for error messages.
      integer, intent(inout) :: info
         !! The variable designating why the computations were stopped.
      integer, intent(in) :: d1
         !! The 1st digit (from the left) of `info`.
      integer, intent(in) :: d2
         !! The 2nd digit (from the left) of `info`.
      integer, intent(in) :: d3
         !! The 3rd digit (from the left) of `info`.
      integer, intent(in) :: d4
         !! The 4th digit (from the left) of `info`.
      integer, intent(in) :: d5
         !! The 5th digit (from the left) of `info`.
      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) :: nq
         !! The number of responses per observation.
      integer, intent(in) :: ldscld
         !! The leading dimension of array `scld`.
      integer, intent(in) :: ldstpd
         !! The leading dimension of array `stpd`.
      integer, intent(in) :: ldwe
         !! The leading dimension of array `we`.
      integer, intent(in) :: ld2we
         !! The second dimension of array `we`.
      integer, intent(in) :: ldwd
         !! The leading dimension of array `wd`.
      integer, intent(in) :: ld2wd
         !! The second dimension of array `wd`.
      integer, intent(in) :: lwkmn
         !! The minimum acceptable length of array `work`.
      integer, intent(in) :: liwkmn
         !! The minimum acceptable length of array `iwork`.

      ! 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.
      !  INFO:    The variable designating why the computations were stopped.
      !  LDSCLD:  The leading dimension of array SCLD.
      !  LDSTPD:  The leading dimension of array STPD.
      !  LDWD:    The leading dimension of array WD.
      !  LDWE:    The leading dimension of array WE.
      !  LIWKMN:  The minimum acceptable length of array IWORK.
      !  LWKMN:   The minimum acceptable length of array WORK.
      !  LD2WD:   The second dimension of array WD.
      !  LD2WE:   The second dimension of array WE.
      !  LUNERR:  The logical unit number used for error messages.
      !  M:       The number of columns of data in the explanatory variable.
      !  N:       The number of observations.
      !  NQ:      The number of responses per observation.

      ! 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) lwkmn
            end if
            if (d5 == 2 .or. d5 == 3) then
               write (lunerr, 2420) liwkmn
            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 >= nq) then
                     write (lunerr, 3310)
                  else
                     write (lunerr, 3320)
                  end if
               else
                  if (ld2we >= nq) 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
      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 :  NQ is less than one.')
2110  format &
         (/' ERROR :  LDX is less than N.')
2120  format &
         (/' ERROR :  LDY is less than 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 NQ'/ &
           '          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 :  LWORK is less than ', I7, ','/ &
           '          the smallest acceptable dimension of array WORK.')
2420  format &
         (/' ERROR :  LIWORK is less than ', I7, ','/ &
           '          the smallest acceptable dimension of array', &
           ' IWORK.')
3110  format &
         (/' ERROR :  SCLD(I,J) is less than or equal to zero'/ &
           '          for some I = 1, ..., N and J = 1, ..., M.'// &
           '          when SCLD(1,1) is greater than zero'/ &
           '          and LDSCLD is greater than or equal to N then'/ &
           '          each of the N by M elements of'/ &
           '          SCLD must be greater than zero.')
3120  format &
         (/' ERROR :  SCLD(1,J) is less than or equal to zero'/ &
           '          for some J = 1, ..., M.'// &
           '          when SCLD(1,1) is greater than zero'/ &
           '          and LDSCLD is equal to one then'/ &
           '          each of the 1 by M elements of'/ &
           '          SCLD must be greater than zero.')
3130  format &
         (/' ERROR :  SCLB(K) is less than or equal to zero'/ &
           '          for some K = 1, ..., NP.'// &
           '          all NP elements of', &
           '          SCLB must be greater than zero.')
3210  format &
         (/' ERROR :  STPD(I,J) is less than or equal to zero'/ &
           '          for some I = 1, ..., N and J = 1, ..., M.'// &
           '          when STPD(1,1) is greater than zero'/ &
           '          and LDSTPD is greater than or equal to N then'/ &
           '          each of the N by M elements of'/ &
           '          STPD must be greater than zero.')
3220  format &
         (/' ERROR :  STPD(1,J) is less than or equal to zero'/ &
           '          for some J = 1, ..., M.'// &
           '          when STPD(1,1) is greater than zero'/ &
           '          and LDSTPD is equal to one then'/ &
           '          each of the 1 by M elements of'/ &
           '          STPD must be greater than zero.')
3230  format &
         (/' ERROR :  STPB(K) is less than or equal to zero'/ &
           '          for some K = 1, ..., NP.'// &
           '          all NP elements of', &
           ' STPB must be greater than zero.')
3310  format &
         (/' ERROR :  At least one of the (NQ by NQ) arrays starting'/ &
           '          in WE(I,1,1), I = 1, ..., N, is not positive'/ &
           '          semidefinite.  When WE(1,1,1) is greater than'/ &
           '          or equal to zero, and LDWE is greater than or'/ &
           '          equal to N, and LD2WE is greater than or equal'/ &
           '          to NQ, then each of the (NQ by NQ) arrays in WE'/ &
           '          must be positive semidefinite.')
3320  format &
         (/' ERROR :  At least one of the (1 by NQ) arrays starting'/ &
           '          in WE(I,1,1), I = 1, ..., N, has a negative'/ &
           '          element.  When WE(1,1,1) is greater than or'/ &
           '          equal to zero, and LDWE is greater than or equal'/ &
           '          to N, and LD2WE is equal to 1, then each of the'/ &
           '          (1 by NQ) arrays in WE must have only non-'/ &
           '          negative elements.')
3410  format &
         (/' ERROR :  The (NQ by NQ) array starting in WE(1,1,1) is'/ &
           '          not positive semidefinite.  When WE(1,1,1) is'/ &
           '          greater than or equal to zero, and LDWE is equal'/ &
           '          to 1, and LD2WE is greater than or equal to NQ,'/ &
           '          then the (NQ by NQ) array in WE must be positive'/ &
           '          semidefinite.')
3420  format &
         (/' ERROR :  The (1 by NQ) array starting in WE(1,1,1) has'/ &
           '          a negative element.  When WE(1,1,1) is greater'/ &
           '          than or equal to zero, and LDWE is equal to 1,'/ &
           '          and LD2WE is equal to 1, then the (1 by NQ)'/ &
           '          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) is greater than zero,'/ &
           '          and LDWD is greater than or equal to N, and'/ &
           '          LD2WD is greater than or equal to 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) is greater than zero,'/ &
           '          and LDWD is greater than or equal to N, and'/ &
           '          LD2WD is equal to 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) is'/ &
           '          greater than zero, and LDWD is equal to 1, and'/ &
           '          LD2WD is greater than or equal to 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) is greater'/ &
           '          than zero, and LDWD is equal to 1, and LD2WD is'/ &
           '          equal to 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 or not associated.')
5100  format &
         (/' ERROR :  JOB requires the optional argument WORK and'/ &
           '          WORK is not present or not associated.')
5200  format &
         (/' ERROR :  JOB requires the optional argument IWORK and'/ &
           '          IWORK is not present or not associated.')
6000  format &
         (/' ERROR :  LOWER(K)>UPPER(K) for some K.  Adjust the'/ &
           '          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.  Increase the'/ &
           '          range of 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.  Increase the bounds or supply'/ &
           '          an analytic jacobian.')
7200  format &
         (/' ERROR :  DELTA could not be allocated. ')
7300  format &
         (/' ERROR :  WORK 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 size. ')
8002  format &
         (/' ERROR :  X has incorrect size. ')
8003  format &
         (/' ERROR :  DELTA has incorrect size. ')
8004  format &
         (/' ERROR :  WE has incorrect size. ')
8005  format &
         (/' ERROR :  WD has incorrect size. ')
8006  format &
         (/' ERROR :  IFIXB has incorrect size. ')
8007  format &
         (/' ERROR :  IFIXX has incorrect size. ')
8008  format &
         (/' ERROR :  STPB has incorrect size. ')
8009  format &
         (/' ERROR :  STPD has incorrect size. ')
8010  format &
         (/' ERROR :  SCLB has incorrect size. ')
8011  format &
         (/' ERROR :  SCLD has incorrect size. ')
8012  format &
         (/' ERROR :  WORK 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 dodpe1