SUBROUTINE POpt(subr, little, medium, full, ithcall, ithsub)
!

!  P U R P O S E   O F    S U B R O U T I N E
!----------------------------------------------------------------------
!  this routine sets the following parameters for printing options:
!  little......minimal output option
!  medium......medium output option
!  full........debug output option
!
!  on entering the following should be defined:
!  subr........routine name (8 Hollerith CHARACTERs at most)
!  ithcall.....ith-CALL from routine subr (initialize to zero)


!  I N P U T    A R G U M E N T S
!  subr
!  little
!  medium
!  full
!  ithcall
!  ithsub


! <><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>


USE Numeric_Kinds_Module
USE FileUnits_Module
USE Prntng_Module, ONLY: Option, IPrtAll, Iter, Iprt, nsubs
USE SubList_Module
IMPLICIT NONE
LOGICAL Little, medium, Full
INTEGER i, ithcall, prtopt, Ithsub

!  C H A R A C T E R S

CHARACTER(LEN=8) subr, subq
CHARACTER(LEN=10) name1, name2, blank

blank = '          '
!----------------------------------------------------------------------
!  check to see if parameters have already been set
!  and will not be altered (ithcall<0).
!----------------------------------------------------------------------
IF(option == 'all     ')THEN
   IF(iprtall == 0)THEN
      little = .false.
      medium = .false.
      full   = .false.
   ELSEIF (iprtall == 1)THEN
      little = .true.
      medium = .false.
      full   = .false.
   ELSEIF (iprtall == 2)THEN
      little = .true.
      medium = .true.
      full   = .false.
   ELSEIF (iprtall == 3)THEN
      little = .true.
      medium = .true.
      full   = .true.
   ELSE
      WRITE(output_unit,*)'Invalid iprtall'
      STOP 'popt'
   ENDIF
   RETURN
ENDIF
IF(ithcall < 0) RETURN
IF(ithcall > 0)THEN
   ithcall=ithcall+1
   IF(Ithsub>0)THEN
   IF(iter(3,ithsub)+iter(2,ithsub)+iter(1,ithsub) < ithcall)little=.false.
   IF(iter(3,ithsub)+iter(2,ithsub) < ithcall) medium=.false.
   IF(iter(3,ithsub) < ithcall) full=.false.
   IF( .NOT. little) ithcall=-1
   ENDIF
   WRITE(output_unit,13) subr, ithcall, little, medium, full
   RETURN
ENDIF
!----------------------------------------------------------------------
!  set default printing options.
!----------------------------------------------------------------------
prtopt=0
little=.false.
medium=.false.
full=.false.
ithcall=-1
!----------------------------------------------------------------------
!  find routine `subr' in the list of routines and determine print
!  options.
!----------------------------------------------------------------------
DO 1 i=1, nsubs
   name1 = blank
   name2 = blank
   subq = subs(i)
   name1 = subr(:LEN(subr)) // char(0)
   name2 = subq(:LEN(subq)) // char(0)
   IF(name1 == name2)THEN
      prtopt=iprt(i)
      IF(prtopt/=0)THEN
         WRITE(output_Unit,334)name1,prtopt
 334           FORMAT('Turning on print for routine: ',a10, 'Printing level = ', i2)
      ENDIF
      ithsub=i
      GOTO 2
   ENDIF
    1 CONTINUE
    2 CONTINUE
!----------------------------------------------------------------------
!  reset print options if needed.
!  return if no printing is desired.
!----------------------------------------------------------------------
IF(prtopt == 0)THEN
   RETURN
!----------------------------------------------------------------------
!  minimal printing option.
!----------------------------------------------------------------------
ELSEIF (prtopt == 1)THEN
   little=.true.
!----------------------------------------------------------------------
!  medium printing option.
!----------------------------------------------------------------------
ELSEIF (prtopt == 2)THEN
   little=.true.
   medium=.true.
!----------------------------------------------------------------------
!  full debug printing option.
!----------------------------------------------------------------------
ELSEIF (prtopt == 3)THEN
   little=.true.
   medium=.true.
   full=.true.
!----------------------------------------------------------------------
!  printing level based on the number of calls made.
!----------------------------------------------------------------------
ELSEIF (prtopt == 4)THEN
   IF(iter(3,ithsub)+iter(2,ithsub)+iter(1,ithsub) > 0)little=.true.
   IF(iter(3,ithsub)+iter(2,ithsub) > 0) medium=.true.
   IF(iter(3,ithsub) > 0) full=.true.
   ithcall=1
   WRITE(output_unit,13) subr, ithcall, little, medium, full
!----------------------------------------------------------------------
!  prtopt does not have correct value STOP!!
!----------------------------------------------------------------------
ELSE
   WRITE(output_unit,*) 'error in routine popt ','(prtopt incorrect) ', prtopt
   STOP 'popt'
ENDIF

RETURN
 13   FORMAT(1x, 'No. of times ', a8, ' has been called=', i5,&
     '  little=', l1, '  medium=', l1, '  full=', l1)
ENDSUBROUTINE POpt