*DECK SLADOC
      PROGRAM SLADOC
C***BEGIN PROLOGUE  SLADOC
C***PURPOSE   Retrieve documentation for the SLATEC library.
C***LIBRARY   (NONE)
C***CATEGORY  R4
C***KEYWORDS  DOCUMENTATION, SLATEC
C***AUTHOR  Boland, W. Robert, C-8, Los Alamos National Laboratory
C           Bacon, Barbara A., C-10, Los Alamos National Laboratory
C***DESCRIPTION
C
C   This program retrieves SLATEC type documentation by routine name.
C   The search for name can be narrowed by using keyword(s) or
C   classification category.  The database for this program consists of
C   four files, generated by another program.  These are
C
C   1)  a direct access documentation text file,
C   2)  a sequential table of routine names, categories, etc.,
C   3)  a sequential file of keywords and pointers to the routines.
C   4)  a sequential file of expanded categories and messages.
C
C   There are a number of system dependent parameters which the
C   installer of this program may have to change before compiling,
C   linking and installing the program.  All parameters are defined in
C   the records which immediately follow the prologue.  In the
C   discussion here we refer to the default values which are distributed
C   with this code;  we give values for several different
C   machine/operating system configurations.
C
C      MXLFN  - the maximum length of a file name to be used.  The value
C               used is highly system dependent.  Set the value to the
C               length of longest file name allowed on the system.
C      FIN    - the name of the input file.  Some typical names are
C               tty (CTSS), INPUT (NOS), /dev/tty (UNIX) and
C               SYS$INPUT (VMS).
C      FTBL   - the name of the input sequential file which contains
C               the table of routine names, categories, etc.
C      FCAT   - the name of the input file which contains the category
C               information.
C      FKWD   - the name of the input sequential file which contains
C               the table of keywords and routine names.
C      FDAF   - the name of the input direct access file which contains
C               the documentation modules.
C      FOUT   - the name of the output file.  Some typical names are
C               tty (CTSS), OUTPUT (NOS), /dev/tty (UNIX) and
C               SYS$OUTPUT (VMS).
C      FERR   - the name of the file which is to contain error
C               information.  All errors are processed by the XERMSG
C               package.  Some typical names are  tty (CTSS),
C               OUTPUT (NOS), /dev/tty (UNIX) and SYS$OUTPUT (VMS).
C
C      MXLRN  - the maximum length of a routine name.  For most Fortran
C               based libraries, including SLATEC, the value must be at
C               least 6.  If your library uses names longer than 6, you
C               should set the value of this parameter to the maximum
C               length.
C      MXNRN  - the maximum number of routine names which are in the
C               library.
C      MXLCAT - the maximum length of a category number.  For the GAMS
C               classification scheme which is used by the SLATEC
C               Collection, the value is 10.
C      MXNCAT - the maximum number of categories in the entire library.
C      MXNKWD - the maximum number of keyword phrases in the entire
C               library.
C      MXNCL  - the maximum number of lines in the GAMS classification
C               file.
C      KMAXI  - the maximum number of characters in a keyword phrase.
C      KMAXJ  - the maximum number of keywords in a subroutine.
C      LLN    - the number of characters in an input line.
C
C   On some systems, it may be necessary to remove or comment out the
C   REWIND (UNIT=LU5, ERR=...) statements to avoid program abort.  It
C   has been found that on most systems these REWIND statements have no
C   effect and can be either "active" or commented out;  they have been
C   incorporated into the code for those few systems which interpret a
C   null line as an end-of-file signal.
C
C***REFERENCES  Guide to the SLATEC Common Mathematical Library.
C***ROUTINES CALLED  I1MACH, XERMSG
C***REVISION HISTORY  (YYMMDD)
C   870819  DATE WRITTEN
C   880325  REVISION DATE from Version 3.2
C   891215  Prologue converted to Version 4.0 format.  (BAB)
C   901024  Added code to check array bounds when reading files.  (BAB)
C   910325  Changed A6 format used when printing routine name list to an
C           A format.  (WRB)
C   920825  Added view option.  (BKS, WRB)
C   920911  Declarations section restructured.  (WRB)
C***END PROLOGUE  SLADOC
C
C     System dependent parameter definitions.
C
      INTEGER MXLFN
      PARAMETER (MXLFN = 32)
      CHARACTER * (MXLFN) FIN, FCAT, FDAF, FKWD, FTBL, FLIS, FOUT, FERR
      CHARACTER * (MXLFN) TEMP
      PARAMETER (FIN  = '/dev/tty',
     +           FCAT = 'slacat',
     +           FDAF = 'sladaf',
     +           FKWD = 'slakwd',
     +           FTBL = 'slatbl',
     +           FLIS = 'slalis',
     +           FOUT = '/dev/tty',
     +           FERR = '/dev/tty')
C
C     Library dependent parameter definitions.
C
      INTEGER MXLCAT, MXNCAT, MXLRN, MXNCL, MXNRN, MXLKAT
      PARAMETER (MXLKAT = 7)
      PARAMETER (MXLCAT = 10, MXLRN = 6, MXNRN = 1900)
      PARAMETER (MXNCAT = 750, MXNCL = 750)
      CHARACTER * (MXLCAT) TCLASS(MXNCAT), TCL
      INTEGER IPTR(MXNCAT), JPTR(MXNCAT), KPTR(MXNCAT)
      CHARACTER * 80 STMTS(MXNCL)
      INTEGER LUTIL, LLIB
      PARAMETER (LUTIL = 6, LLIB = 6)
      CHARACTER * (LUTIL) UTIL
      CHARACTER * (LLIB) LIB
      PARAMETER (UTIL = 'SLADOC', LIB = 'SLATEC')
      INTEGER LLN
      PARAMETER (LLN = 72)
C
C     Other declarations.
C
      INTEGER IERROR, IFIND, II, IJ, IL, ILEN, IN, INEXT, IR, IREC,
     +        ISTART, ISTMT, ITEMP, JCL, JJ, LB2, LENG, LFTBL, LKATS,
     +        LL, LS, LT2, LTCL, NCC, NERR, NLINES, NPD, NTKWD,
     +        NTRY, NUM
      CHARACTER * (LLN) LINE, LINESV
C
      CHARACTER * (MXLRN) RTNAME(MXNRN), RTNIN
      CHARACTER * (MXLRN) CNAME(MXNRN/2)
C
      INTEGER LCAT, LCATLS, MLCAT, SEVEN
      PARAMETER (LCAT = 6, LCATLS = 72, MLCAT = MXLCAT-LCAT, SEVEN = 7)
      CHARACTER * (MXLCAT) CAT(MXNRN), KAT
      CHARACTER * (MXLKAT) KATS
C
C     KMAXI - maximum length of a keyword phrase.
C     MXKWDS - maximum number of keyword phrases
C
      INTEGER KMAXI, MXKWDS
      PARAMETER (KMAXI = 60, MXKWDS = 500)
      CHARACTER * (KMAXI) KWRD
      CHARACTER * (KMAXI) TKWD(MXKWDS)
C
C     IPTRL - table of pointers associated with the keyword phrases.
C     IPTRR - table of pointers to the routines containing the
C             keyword phrases.
C
      INTEGER IPTRL(10*MXKWDS), IPTRR(10*MXKWDS)
C
      INTEGER LU13, LU14, LU5, LU6, LU17, LU18, LU19
      PARAMETER (LU13 = 13, LU14 = 14, LU5 = 5, LU6 = 6, LU17 = 17,
     +           LU18 = 18, LU19 = 19)
      CHARACTER * (MXLFN) FNAME, FNAMSV, FN
      LOGICAL LLU13, LLU18, LLU19, LLU14
      LOGICAL FOUND, LEXIST
C
C     IS  - table of pointers to the record in file FDAF containing
C           the subprogram statement.
C     IE  - table of pointers to the record in file FDAF containing
C           the "END PROLOGUE" statement.
C     IPS - table of pointers to the record in file FDAF containing
C           starting line of the "PURPOSE" section.
C     IPE - table of pointers to the record in file FDAF containing
C           ending line of the "PURPOSE" section.
C
      INTEGER IS(MXNRN), IE(MXNRN), IPS(MXNRN), IPE(MXNRN)
      INTEGER I, INFO, J, LB, LT
C
      CHARACTER * 1 INPUT1
      CHARACTER * 24 FMT1
      CHARACTER * (LUTIL+LLIB+54) FMT2
      CHARACTER * 80 MSG
      CHARACTER FORM * 25
      CHARACTER FORMA * 60
      INTEGER IALPHA
      PARAMETER (IALPHA = 26)
      INTEGER I1(IALPHA), I2(IALPHA), I3(IALPHA), LMSG(IALPHA)
      CHARACTER * 7 CLASS(IALPHA)
C
C     Variables used in the browsing mode.
C
      INTEGER PGSZ, LOW, HIGH
      COMMON /CATGRY/ I1, I2, I3, LMSG
      COMMON /KLASS/ CLASS
C
C     External functions.
C
      INTEGER FIND, LENSTR, MINOR
      CHARACTER*10 CVTCAT
      EXTERNAL CVTCAT, FIND, LENSTR, MINOR
C
C     Intrinsic functions.
C
      INTRINSIC ABS, INDEX, MAX, MIN
C
C     DATA statement definitions.
C
      DATA LLU13 /.FALSE./, FNAMSV /' '/
C
C     These three variables indicate whether the information from
C     the files FCAT, FTBL and FKWD have been read in.  The files
C     are read only once and then only if the information is needed.
C
      DATA LLU18, LLU19, LLU14 /.FALSE.,.FALSE.,.FALSE./
C
      DATA FORMA(1:29), FORMA(30:60) /'(/, 1X, A  , '' category does ',
     +                               'not exist in this library.'', /)'/
C***FIRST EXECUTABLE STATEMENT  SLADOC
      WRITE (UNIT=MSG, FMT=9720) LCAT, MLCAT
      FMT1 = '(1X, A' // MSG(1:2) // ', ' // MSG(3:4) // 'X, A, 3I8)'
      FNAME = FLIS
C
C     OPEN (UNIT=LU5, FILE=FIN, STATUS='UNKNOWN', IOSTAT=INFO,
C    +      FORM='FORMATTED')
C     IF (INFO .NE. 0) THEN
C       MSG = 'Failure in attempting to open ' // FIN // ' for input'
C       NERR = 1
C       GO TO 520
C     ENDIF
C
C     OPEN (UNIT=LU6, FILE=FOUT, STATUS='UNKNOWN', IOSTAT=INFO,
C    +      FORM='FORMATTED')
C     IF (INFO .NE. 0) THEN
C       MSG = ' Failure in attempting to open ' // FOUT // ' for output'
C       NERR = 1
C       GO TO 520
C     ENDIF
C
C     Check to see if the input files to be used are in the user's
C     local space.  If so, use them instead of the ones on the
C     system.
C
      TEMP = FDAF
      ILEN = LENSTR(TEMP)
      DO 10 I = ILEN,1,-1
        IF (TEMP(I:I) .EQ. '/') THEN
          INQUIRE (FILE=TEMP(I+1:ILEN), EXIST=LEXIST)
          IF (LEXIST) THEN
            TEMP = TEMP(I+1:ILEN)
          ENDIF
          GO TO 20
        ENDIF
   10 CONTINUE
   20 OPEN (UNIT=LU17, FILE=TEMP, STATUS='OLD', ACCESS='DIRECT',
     +      FORM='FORMATTED', RECL = LLN, IOSTAT = INFO)
      IF (INFO .NE. 0) THEN
        MSG = ' Failure in attempting to open ' // TEMP
        NERR = 1
        GO TO 940
      ENDIF
      TEMP = FCAT
      ILEN = LENSTR(TEMP)
      DO 30 I = ILEN,1,-1
        IF (TEMP(I:I) .EQ. '/') THEN
          INQUIRE (FILE=TEMP(I+1:ILEN), EXIST=LEXIST)
          IF (LEXIST) THEN
            TEMP = TEMP(I+1:ILEN)
          ENDIF
          GO TO 40
        ENDIF
   30 CONTINUE
   40 OPEN (UNIT=LU14, FILE=TEMP, STATUS='OLD', FORM='FORMATTED',
     +      IOSTAT=INFO)
      IF (INFO .NE. 0) THEN
        MSG = ' Failure in attempting to open ' // TEMP
        NERR = 1
        GO TO 940
      ENDIF
      TEMP = FKWD
      ILEN = LENSTR(TEMP)
      DO 50 I = ILEN,1,-1
        IF (TEMP(I:I) .EQ. '/') THEN
          INQUIRE (FILE=TEMP(I+1:ILEN), EXIST=LEXIST)
          IF (LEXIST) THEN
            TEMP = TEMP(I+1:ILEN)
          ENDIF
          GO TO 60
        ENDIF
   50 CONTINUE
   60 OPEN (UNIT=LU19, FILE=TEMP, STATUS='OLD', FORM='FORMATTED',
     +      IOSTAT=INFO)
      IF (INFO .NE. 0) THEN
        MSG = ' Failure in attempting to open ' // TEMP
        NERR = 1
        GO TO 940
      ENDIF
      TEMP = FTBL
      ILEN = LENSTR(TEMP)
      DO 70 I = ILEN,1,-1
        IF (TEMP(I:I) .EQ. '/') THEN
          INQUIRE (FILE=TEMP(I+1:ILEN), EXIST=LEXIST)
          IF (LEXIST) THEN
            TEMP = TEMP(I+1:ILEN)
          ENDIF
          GO TO 80
        ENDIF
   70 CONTINUE
   80 OPEN (UNIT=LU18, FILE=TEMP, STATUS='OLD', FORM='FORMATTED',
     +      IOSTAT=INFO)
      IF (INFO .NE. 0) THEN
        MSG = ' Failure in attempting to open ' // TEMP
        NERR = 1
        GO TO 940
      ENDIF
C
C     Write welcome message.
C
      FMT2 = '('' Welcome to ' // UTIL // ', the ' // LIB //
     +         ' on-line documentation program'' /)'
      WRITE (UNIT=LU6, FMT=FMT2)
C
C     Write the complete message showing the commands.
C
   90 WRITE (UNIT=LU6, FMT=9020)
C
C     Write "Ready for your command".
C
  100 WRITE (UNIT=LU6, FMT=9030)
      REWIND (UNIT=LU5, ERR=110)
  110 READ (UNIT=LU5, FMT=9000, END=120) LINE
      CALL UPCASE (LINE, LINE)
      GO TO 130
  120 LINE = ' '
  130 LENG = LENSTR(LINE)
      CALL CHARIN (LINE, LENG, 2, LB, LT)
  140 LB = MAX(LB,1)
      IF (LINE(LB:LB).EQ.'L' .OR. LINE(LB:LB).EQ.'C' .OR.
     +    LINE(LB:LB).EQ.'K' .OR. LINE(LB:LB).EQ.'X' .OR.
     +    LINE(LB:LB).EQ.'V') THEN
        INPUT1 = LINE(LB:LB)
C
C
        IF (INPUT1 .EQ. 'L') THEN
C
C         User has requested information on the GAMS classification
C         scheme.
C
          IF (.NOT.LLU14) THEN
C
C           Read in the information from file FCAT.
C
            READ (UNIT=LU14, FMT=9700) NCC
            IF (NCC .GT. MXNCAT) THEN
              MSG = 'MXNCAT internal error.  Please contact the '
     +              // 'consulting office.'
              NERR = 3
              GO TO 940
            ENDIF
            NCC = NCC-1
            DO 150 J = 1,NCC
              READ (UNIT=LU14, FMT=9730) IPTR(J), JPTR(J),
     +              KPTR(J), TCLASS(J)
  150        CONTINUE
            READ (UNIT=LU14, FMT=9710) KPTR(NCC+1)
            ISTMT = KPTR(NCC+1)
            IF (ISTMT .GT. MXNCL) THEN
              MSG = 'MXNCL internal error.  Please contact the '
     +              // 'consulting office.'
              NERR = 4
              GO TO 940
            ENDIF
            READ (UNIT=LU14, FMT=9000) (STMTS(I), I=1, ISTMT)
            LLU14 = .TRUE.
            CLOSE (LU14)
          ENDIF
          LS = LT+LB
          CALL CHARIN (LINE(LS:LS), LENG, 2, LB, LT)
          IF (LT .EQ. 0) THEN
C
C           CASE I.  l <cr>    or    l<cr>
C
C           Print out the major categories.
C
            WRITE (UNIT=LU6, FMT=9100)
            KAT = TCLASS(1)
            IFIND = FIND(TCLASS,NCC,KAT)
  160       IF (IFIND .GT. 0) THEN
C
              I1(1) = IPTR(IFIND)
              I3(1) = KPTR(IFIND)
              TCL = ' '
              CALL UNDOCL (TCLASS(IFIND), TCL)
              LMSG(1) = KPTR(IFIND+1)-KPTR(IFIND)
              IFIND = I1(1)
              LTCL = LENSTR(TCL)
              WRITE (UNIT=FORM, FMT=9740) LTCL
              ISTART = I3(1)
              DO 170 JCL = 1,LMSG(1)
                WRITE (UNIT=LU6, FMT=FORM) TCL(1:LTCL),
     +                 STMTS(ISTART)(1:LENSTR(STMTS(ISTART)))
                ISTART = ISTART+1
                TCL = ' '
  170         CONTINUE
              GOTO 160
            ENDIF
C
C           Ask the user to input a MAJOR category he/she wishes to
C           explore.
C
            WRITE (UNIT=LU6, FMT=9110)
            REWIND (UNIT=LU5, ERR=180)
  180       READ (UNIT=LU5, FMT=9000, END=90) LINE
            CALL UPCASE (LINE, LINE)
C
C           Remove leading blanks from the input line.
C
            CALL RBLNKS (LINE, LINESV)
            KAT = LINESV(1:1)
            KATS = KAT
C
C           KATS is the unexpanded version of the category name.
C           KAT  is the expanded version of the category name.
C           E.G.,  If (KAT) = H02A01A01, then (KATS) = H2A1A1.
C
  190       IERROR = MINOR(KAT, KATS, NCC, TCLASS, IPTR, JPTR, KPTR,
     +               NTRY)
            IF (IERROR .NE. 0) THEN
              WRITE (UNIT=LU6, FMT=9230) KATS
              GO TO 100
            ELSE
C
C             The first entry is a repeat of the category information
C             he/she now wishes to explore.
C
              LKATS = LENSTR(KATS)
              WRITE (UNIT=FORM, FMT=9740) LKATS
              ISTART = I3(1)
              TCL = KATS
              DO 200 JCL = 1,LMSG(1)
                WRITE (UNIT=LU6, FMT=FORM) TCL(1:LKATS),
     +                 STMTS(ISTART)(1:LENSTR(STMTS(ISTART)))
                ISTART = ISTART+1
                TCL = ' '
  200         CONTINUE
            ENDIF
            IF (NTRY .GT. 1) THEN
              DO 220 IN = 2,NTRY
                TCL = CLASS(IN)
                LTCL = LENSTR(TCL)
                WRITE (UNIT=FORM, FMT=9740) LTCL
                ISTART = I3(IN)
                DO 210 JCL = 1,LMSG(IN)
                  WRITE (UNIT=LU6, FMT=FORM) TCL(1:LTCL),
     +                   STMTS(ISTART)(1:LENSTR(STMTS(ISTART)))
                  ISTART = ISTART+1
                  TCL = ' '
  210           CONTINUE
  220         CONTINUE
              WRITE (UNIT=LU6, FMT=9120)
              LINE = ' '
              REWIND (UNIT=LU5, ERR=230)
  230         READ (UNIT=LU5, FMT=9000, END=100) LINE
              IF (LENSTR(LINE) .EQ. 0) GO TO 100
              CALL RBLNKS (LINE, LINESV)
              LENG = LENSTR(LINESV)
              CALL UPCASE (LINESV(1:LENG), KATS)
              KAT = CVTCAT(KATS(1:LENG))
              GO TO 190
            ELSE
              WRITE (UNIT=LU6, FMT=9130) KATS
              KATS = ' '
              WRITE (UNIT=LU6, FMT=9140)
              GO TO 100
            ENDIF
          ELSE
C
C           CASE II.    l,cat <cr>
C
            LL = LS-1+LB
            IF ((LENG-LL+1) .GT. MXLKAT) THEN
C
C             A longer category has been requested than permitted.
C
              WRITE (UNIT=FORM, FMT=9720) LENG-LL+1
              FORMA(10:11) = FORM(1:2)
              WRITE (UNIT=LU6, FMT=FORMA) LINE(LL:LENG)
              GO TO 100
            ENDIF
            KATS = LINE(LL:LENG)
            LENG = LENSTR(KATS)
            KAT = CVTCAT(KATS(1:LENG))
C
C           KATS is the unexpanded version of the category name.
C           KAT  is the expanded version of the category name.
C           E.G.,  If (KAT) = H02A01A01, then  (KATS) = H2A1A1.
C
  240       IERROR = MINOR(KAT, KATS, NCC, TCLASS, IPTR, JPTR, KPTR,
     +               NTRY)
            IF (IERROR .NE. 0) THEN
C
C             Category not found in this library.
C
              WRITE (UNIT=LU6, FMT=9230) KATS
              GO TO 100
            ELSE
C
C             The first entry is a repeat of the category information
C             he/she now wishes to explore.
C
              LKATS = LENSTR(KATS)
              WRITE (UNIT=FORM, FMT=9740) LKATS
              ISTART = I3(1)
              TCL = KATS
              DO 250 JCL = 1,LMSG(1)
                WRITE (UNIT=LU6, FMT=FORM) TCL(1:LKATS),
     +                 STMTS(ISTART)(1:LENSTR(STMTS(ISTART)))
                ISTART = ISTART+1
                TCL = ' '
  250         CONTINUE
            ENDIF
            IF (NTRY .GT. 1) THEN
              DO 270 IN = 2,NTRY
                TCL = CLASS(IN)
                LTCL = LENSTR(TCL)
                WRITE (UNIT=FORM, FMT=9740) LTCL
                ISTART = I3(IN)
                DO 260 JCL = 1,LMSG(IN)
                  WRITE (UNIT=LU6, FMT=FORM) TCL(1:LTCL),
     +                   STMTS(ISTART)(1:LENSTR(STMTS(ISTART)))
                  ISTART = ISTART+1
                  TCL = ' '
  260           CONTINUE
  270         CONTINUE
              WRITE (UNIT=LU6, FMT=9120)
              LINE = ' '
              REWIND (UNIT=LU5, ERR=280)
  280         READ (UNIT=LU5, FMT=9000, END=100) LINE
              IF (LENSTR(LINE) .EQ. 0) GO TO 100
              CALL RBLNKS (LINE, LINESV)
              LENG = LENSTR(LINESV)
              CALL UPCASE (LINESV(1:LENG), KATS)
              KAT = CVTCAT(KATS(1:LENG))
              GO TO 240
            ELSE
              WRITE (UNIT=LU6, FMT=9130) KATS
              KATS = ' '
              WRITE (UNIT=LU6, FMT=9140)
              GO TO 100
            ENDIF
          ENDIF
C
        ELSEIF (INPUT1 .EQ. 'K') THEN
C
C         User is looking for routine names by keyword phrase.
C
          IF (.NOT.LLU19) THEN
C
C           Read in the information from file FKWD.
C
            READ (UNIT=LU19, FMT=9700) NTKWD
            WRITE (UNIT=FORM, FMT=9750) KMAXI
            IF (NTKWD .GT. MXKWDS) THEN
              MSG = 'MXKWDS internal error.  Please contact the '
     +              // 'consulting office.'
              NERR = 5
              GO TO 940
            ENDIF
            READ (UNIT=LU19, FMT=FORM) (TKWD(J), J=1, NTKWD)
C
            INEXT = 0
  290       CONTINUE
            READ (UNIT=LU19, FMT=9000, END=300) LINESV
            IF (INEXT .GE. 10*MXKWDS) THEN
              MSG = 'MXKWDS internal error.  Please contact the '
     +              // 'consulting office.'
              NERR = 6
              GO TO 940
            ENDIF
            READ (UNIT=LINESV, FMT=9700) IPTRL(INEXT+1), IPTRR(INEXT+1)
            INEXT = INEXT+1
            GO TO 290
  300       CONTINUE
            LLU19 = .TRUE.
            CLOSE (LU19)
          ENDIF
          IF (.NOT.LLU18) THEN
C
C           Read in the information from file FTBL.
C
            LFTBL = 0
  310       CONTINUE
            LFTBL = LFTBL+1
            READ (UNIT=LU18, FMT=9000, END=320) LINESV
            IF (LFTBL .GT. MXNRN) THEN
              MSG = 'MXNRN internal error.  Please contact the '
     +              // 'consulting office.'
              NERR = 2
              GO TO 940
            ENDIF
            READ (UNIT=LINESV, FMT=9310) CAT(LFTBL), RTNAME(LFTBL),
     +            IS(LFTBL), IE(LFTBL), IPS(LFTBL), IPE(LFTBL)
            GO TO 310
  320       CONTINUE
            LFTBL = LFTBL - 1
            LLU18 = .TRUE.
            CLOSE (LU18)
          ENDIF
          LS = LT+LB
          CALL CHARIN (LINE(LS:LS), LENG, 2, LB, LT)
          IF (LT .EQ. 0) THEN
C
C           Ask the user to input the keyword phrase he/she wishes
C           to find.
C
            WRITE (UNIT=LU6, FMT=9300)
            REWIND (UNIT=LU5, ERR=330)
  330       READ (UNIT=LU5, FMT=9000, END=340) LINE
            CALL UPCASE (LINE, LINE)
            GO TO 350
  340       LINE = ' '
  350       LB = 1
            LT = LENSTR(LINE)
            IF (LT .EQ. 0) THEN
              WRITE (UNIT=LU6, FMT=9340)
              GO TO 90
            ENDIF
            KWRD = LINE(LB:LT)
          ELSE
            KWRD = LINE(LS-1+LB:LENG)
          ENDIF
C
C         The keyword phrase was found on the original command line.
C
          ILEN = LENSTR(KWRD)
          FOUND = .FALSE.
          DO 380 I = 1,NTKWD
            IJ = INDEX(TKWD(I),KWRD(1:ILEN))
            IF (IJ .NE. 0) THEN
              FOUND = .TRUE.
C
C             We have found this keyword in one of the phrases.
C
              IJ = I
              IN = 1
  360         IL = IPTRL(IJ)
              IR = IPTRR(IJ)
C
C             Collect together in CNAME all the routines which
C             contain the keyword phrase, so that they can be printed
C             six on a line.
C
              CNAME(IN) = RTNAME(IR)
              IF (IL .EQ. 0) GO TO 370
              IJ = IL
              IN = IN+1
              GO TO 360
  370         WRITE (UNIT=LU6, FMT=9320) TKWD(I)
              WRITE (UNIT=LU6, FMT=9330)
              WRITE (UNIT=LU6, FMT=9760) (CNAME(IJ), IJ=1, IN)
            ENDIF
  380     CONTINUE
          IF (.NOT.FOUND) THEN
            WRITE (UNIT=LU6, FMT=9340)
          ENDIF
C
C
        ELSEIF (INPUT1 .EQ. 'C') THEN
C
C         User is looking for routine names by category.
C
          IF (.NOT.LLU18) THEN
C
C           Read in the information from file FTBL.
C
            LFTBL = 0
  390       CONTINUE
            LFTBL = LFTBL+1
            READ (UNIT=LU18, FMT=9000, END=400) LINESV
            IF (LFTBL .GT. MXNRN) THEN
              MSG = 'MXNRN internal error.  Please contact the '
     +              // 'consulting office.'
              NERR = 2
              GO TO 940
            ENDIF
            READ (UNIT=LINESV, FMT=9310) CAT(LFTBL), RTNAME(LFTBL),
     +            IS(LFTBL), IE(LFTBL), IPS(LFTBL), IPE(LFTBL)
            GO TO 390
  400       CONTINUE
            LFTBL = LFTBL - 1
            LLU18 = .TRUE.
            CLOSE (LU18)
          ENDIF
          LS = LT+LB
          CALL CHARIN (LINE(LS:LS), LENG, 2, LB, LT)
          IF (LT .EQ. 0) THEN
C
C           Ask the user to input the classification category he/she
C           wishes to find.
C
            WRITE (UNIT=LU6, FMT=9200)
            REWIND (UNIT=LU5, ERR=410)
  410       READ (UNIT=LU5, FMT=9000, END=420) LINE
            CALL UPCASE (LINE, LINE)
            GO TO 430
  420       LINE = ' '
  430       LB = 1
            LT = LENSTR(LINE)
            IF (LT .EQ. 0) THEN
              WRITE (UNIT=LU6, FMT=9220)
              GO TO 90
            ENDIF
            KAT = LINE(LB:LT)
          ELSE
C
C           The category appeared on the original input line.
C
            KAT = LINE(LS-1+LB:LS-1+LB+LT-1)
          ENDIF
          IJ = 0
          ILEN = LENSTR(KAT)
          DO 440 I = 1,LFTBL
            IF (KAT .EQ. CAT(I)(1:ILEN)) THEN
              IJ = IJ+1
C
C             Collect together in CNAME all the routines having
C             this category.
C
              CNAME(IJ) = RTNAME(I)
            ENDIF
  440     CONTINUE
          IF (IJ .EQ. 0) THEN
            WRITE (UNIT=LU6, FMT=9220)
          ELSE
            WRITE (UNIT=LU6, FMT=9210)
C
C           Write out the routine names, six per line.
C
            WRITE (UNIT=LU6, FMT=9760) (CNAME(I), I=1, IJ)
          ENDIF
        ELSEIF (INPUT1 .EQ. 'V') THEN
          LS = LT+LB
          CALL CHARIN (LINE(LS:LS), LENG, 2, LB, LT)
          IF (LT .EQ. 0) THEN
C
C           Ask the user to input if he wants classification categories
C           or the keywords.
C
            WRITE (UNIT=LU6, FMT=9600)
            REWIND (UNIT=LU5, ERR=450)
  450       READ (UNIT=LU5, FMT=9000, END=460) LINE
            CALL UPCASE (LINE, LINE)
            GO TO 470
  460       LINE = ' '
  470       LB = 1
            LT = LENSTR(LINE)
            IF (LT .EQ. 0) THEN
              WRITE (UNIT=LU6, FMT=9220)
              GO TO 90
            ENDIF
            KAT = LINE(LB:LT)
          ELSE
C
C           The category appeared on the original input line.
C
            KAT = LINE(LS-1+LB:LS-1+LB+LT-1)
          ENDIF
          IF (KAT(1:1) .EQ. 'C') THEN
            IF (.NOT.LLU14) THEN
C
C             Read in the information from file FCAT.
C
              READ (UNIT=LU14, FMT=9700) NCC
              IF (NCC .GT. MXNCAT) THEN
                MSG = 'MXNCAT internal error.  Please contact the '
     +                // 'consulting office.'
                NERR = 3
                GO TO 940
              ENDIF
              NCC = NCC-1
              DO 480 J = 1,NCC
                READ (UNIT=LU14, FMT=9730) IPTR(J), JPTR(J),
     +                KPTR(J), TCLASS(J)
 480           CONTINUE
              READ (UNIT=LU14, FMT=9710) KPTR(NCC+1)
              ISTMT = KPTR(NCC+1)
              IF (ISTMT .GT. MXNCL) THEN
                MSG = 'MXNCL internal error.  Please contact the '
     +                // 'consulting office.'
                NERR = 4
                GO TO 940
              ENDIF
              READ (UNIT=LU14, FMT=9000) (STMTS(I), I=1, ISTMT)
              LLU14 = .TRUE.
              CLOSE(LU14)
            ENDIF
          ELSEIF (KAT(1:1) .EQ. 'K') THEN
C
C           The keywords are being requested.
C
            IF (.NOT.LLU19) THEN
C
C             Read in the information from file FKWD.
C
              READ (UNIT=LU19, FMT=9700) NTKWD
              WRITE (UNIT=FORM, FMT=9750) KMAXI
              IF (NTKWD .GT. MXKWDS) THEN
                MSG = 'MXKWDS internal error.  Please contact the '
     +                // 'consulting office.'
                NERR = 5
                GO TO 940
              ENDIF
              READ (UNIT=LU19, FMT=FORM) (TKWD(J), J=1, NTKWD)
C
              INEXT = 0
  490         CONTINUE
              READ (UNIT=LU19, FMT=9000, END=500) LINESV
              IF (INEXT .GE. 10*MXKWDS) THEN
                MSG = 'MXKWDS internal error.  Please contact the '
     +                // 'consulting office.'
                NERR = 6
                GO TO 940
              ENDIF
              READ (UNIT=LINESV, FMT=9700) IPTRL(INEXT+1),
     +              IPTRR(INEXT+1)
              INEXT = INEXT+1
              GO TO 490
  500         CONTINUE
              LLU19 = .TRUE.
              CLOSE (LU19)
            ENDIF
          ELSE
            WRITE (UNIT=LU6, FMT=9050)
            GOTO 100
          ENDIF
          IF (KAT(1:1) .EQ. 'C') THEN
            FNAME = 'classlis'
            WRITE (UNIT=LU6, FMT=9610) 'Classification', NCC
          ELSE
            FNAME = 'keylis'
            WRITE (UNIT=LU6, FMT=9610) 'Keyword', NTKWD
          ENDIF
          ILEN = LENSTR(FNAME)
          WRITE (UNIT=LU6, FMT=9620) FNAME(1:ILEN)
C
C         Ask where he/she wants the list information written.
C
          WRITE (UNIT=LU6, FMT=9630)
          READ (UNIT=LU5, FMT=9000) LINE
          LENG = LENSTR(LINE)
          CALL CHARIN (LINE, LENG, 2, LB, LT)
C
C         The user wants to browse through the list on her/his terminal.
C
          IF (LINE(LB:LB).EQ.'b' .OR. LINE(LB:LB).EQ.'B') THEN
            PGSZ = 21
            LOW = 1
            HIGH = PGSZ
  520       WRITE (UNIT=LU6, FMT=9450)
  530       READ (UNIT=LU5, FMT=9000, END=520) LINE
            LENG = LENSTR(LINE)
            CALL UPCASE (LINE, LINE)
            CALL CHARIN (LINE, LENG, 2, LB, LT)
            IF (KAT(1:1) .EQ. 'C') THEN
              NLINES = NCC
            ELSE
              NLINES = NTKWD
            ENDIF
C
C           'SPGSZ'   Set page size
C
            IF (LINE(LB:LB+4) .EQ. 'SPGSZ') THEN
              IF ((LT .EQ. 5) .AND. (LB+4 .EQ. LENG)) THEN
C
C               Print out the current value of PGSZ
C
                WRITE (UNIT=LU6, FMT=9490) PGSZ
              ELSE
C
C               Get a new pgsz
C
                IF (LT+LB-1 .GT. LB+4) THEN
C
C                 There are no spaces between 'spgsz' and a value
C
                  WRITE (FORM, 9460) LT-5
                  READ (LINE(LB+5:LB+LT-1), FORM, ERR=640) PGSZ
                  PGSZ = ABS(PGSZ)
                ELSE
C
C                 There are spaces; call CHARIN again to get the next
C                 field
C
                  LS = LB+LT
                  CALL CHARIN (LINE(LS:LS), LENG, 2, LB2, LT2)
                  WRITE (FORM, 9460) LENG-LS-LB2+2
                  READ (LINE(LS+LB2-1:LENG), FORM,
     +                  ERR=640) PGSZ
                  PGSZ = ABS(PGSZ)
                ENDIF
                WRITE (UNIT=LU6, FMT=9500) PGSZ
              ENDIF
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 530
C
C           'PD'   Page forwards (downward)
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'PD') THEN
              IF ((LT .EQ. 2) .AND. (LB+1 .EQ. LENG)) THEN
C
C               There is no value given; assume one (1).
C
                NPD = 1
              ELSE
                IF (LT+LB-1 .GT. LB+1) THEN
C
C                 There are no spaces between 'pd' and a value
C
                  WRITE (FORM, 9460) LT-2
                  READ (LINE(LB+2:LB+LT-1), FORM, ERR=640) NPD
                ELSE
C
C                 There are spaces; call CHARIN again to get the next
C                 field
C
                  LS = LB+LT
                  CALL CHARIN (LINE(LS:LS), LENG, 2, LB2, LT2)
                  WRITE (FORM, 9460) LENG-LS-LB2+2
                  READ (LINE(LS+LB2-1:LENG), FORM,
     +                  ERR=640) NPD
                ENDIF
              ENDIF
              LOW = MAX(HIGH+(NPD-1)*PGSZ+1, 1)
              HIGH = MIN(LOW + PGSZ-1, NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ,1)
              ENDIF
              DO 550 IREC = LOW, MIN(HIGH,NLINES)
                IF (KAT(1:1) .EQ. 'C') THEN
                  II = KPTR(IREC)
                  TCL = ' '
                  CALL UNDOCL (TCLASS(IREC), TCL)
                  WRITE (UNIT=LU6, FMT=9780) II,
     +                   TCL(1:LENSTR(TCL)),
     +                   STMTS(II)(1:LENSTR(STMTS(II)))
                  ITEMP = KPTR(IREC+1)-KPTR(IREC)-1
                  LTCL = LENSTR(TCL)+3
                  WRITE (UNIT=FORM, FMT=9790) LTCL
                  DO 540 JJ = 1, ITEMP
                    II = II + 1
                    WRITE (UNIT=LU6, FMT=FORM) II,
     +                     STMTS(II)(1:LENSTR(STMTS(II)))
  540             CONTINUE
                ELSE
                  WRITE (UNIT=LU6, FMT=9640) IREC, TKWD(IREC)
                ENDIF
  550         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 530
C
C           'PU'   Page backwards (upward)
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'PU') THEN
              IF ((LT .EQ. 2) .AND. (LB+1 .EQ. LENG)) THEN
C
C               There is no value given; assume one (1).
C
                NPD = 1
              ELSE
                IF (LT+LB-1 .GT. LB+1) THEN
C
C                 There are no spaces between 'pu' and a value
C
                  WRITE (FORM, 9460) LT-2
                  READ (LINE(LB+2:LB+LT-1), FORM, ERR=640) NPD
                ELSE
C
C                 There are spaces; call CHARIN again to get the next
C                 field
C
                  LS = LB+LT
                  CALL CHARIN (LINE(LS:LS), LENG, 2, LB2, LT2)
                  WRITE (FORM, 9460) LENG-LS-LB2+2
                  READ (LINE(LS+LB2-1:LENG), FORM,
     +                  ERR=640) NPD
                ENDIF
              ENDIF
              NPD = -NPD
              LOW = MAX(LOW + NPD*PGSZ, 1)
              HIGH = MIN(LOW + PGSZ-1, NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ,1)
              ENDIF
              DO 570 IREC = LOW, MIN(HIGH,NLINES)
                IF (KAT(1:1) .EQ. 'C') THEN
                  II = KPTR(IREC)
                  TCL = ' '
                  CALL UNDOCL (TCLASS(IREC), TCL)
                  WRITE (UNIT=LU6, FMT=9780) II,
     +                   TCL(1:LENSTR(TCL)),
     +                   STMTS(II)(1:LENSTR(STMTS(II)))
                  ITEMP = KPTR(IREC+1)-KPTR(IREC)-1
                  LTCL = LENSTR(TCL)+3
                  WRITE (UNIT=FORM, FMT=9790) LTCL
                  DO 560 JJ = 1, ITEMP
                    II = II + 1
                    WRITE (UNIT=LU6, FMT=FORM) II,
     +                     STMTS(II)(1:LENSTR(STMTS(II)))
  560             CONTINUE
                ELSE
                  WRITE (UNIT=LU6, FMT=9640) IREC, TKWD(IREC)
                ENDIF
  570        CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 530
C
C           'HD'   Page half a page forward
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'HD') THEN
              LOW = MAX(LOW + PGSZ/2, 1)
              HIGH = MIN(LOW + PGSZ-1,NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ,1)
              ENDIF
              DO 590 IREC = LOW, MIN(HIGH,NLINES)
                IF (KAT(1:1) .EQ. 'C') THEN
                  II = KPTR(IREC)
                  TCL = ' '
                  CALL UNDOCL (TCLASS(IREC), TCL)
                  WRITE (UNIT=LU6, FMT=9780) II,
     +                   TCL(1:LENSTR(TCL)),
     +                   STMTS(II)(1:LENSTR(STMTS(II)))
                  ITEMP = KPTR(IREC+1)-KPTR(IREC)-1
                  LTCL = LENSTR(TCL)+3
                  WRITE (UNIT=FORM, FMT=9790) LTCL
                  DO 580 JJ = 1, ITEMP
                    II = II + 1
                    WRITE (UNIT=LU6, FMT=FORM) II,
     +                     STMTS(II)(1:LENSTR(STMTS(II)))
  580             CONTINUE
                ELSE
                  WRITE (UNIT=LU6, FMT=9640) IREC, TKWD(IREC)
                ENDIF
  590         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 530
C
C           'HU'   Page half a page backward
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'HU') THEN
              LOW = MAX (LOW - PGSZ/2, 1)
              HIGH = MIN(LOW + PGSZ-1,NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ,1)
              ENDIF
              DO 610 IREC = LOW, MIN(HIGH,NLINES)
                IF (KAT(1:1) .EQ. 'C') THEN
                  II = KPTR(IREC)
                  TCL = ' '
                  CALL UNDOCL (TCLASS(IREC), TCL)
                  WRITE (UNIT=LU6, FMT=9780) II,
     +                   TCL(1:LENSTR(TCL)),
     +                   STMTS(II)(1:LENSTR(STMTS(II)))
                  ITEMP = KPTR(IREC+1)-KPTR(IREC)-1
                  LTCL = LENSTR(TCL)+3
                  WRITE (UNIT=FORM, FMT=9790) LTCL
                  DO 600  JJ = 1, ITEMP
                    II = II + 1
                    WRITE (UNIT=LU6, FMT=FORM) II,
     +                     STMTS(II)(1:LENSTR(STMTS(II)))
  600             CONTINUE
                ELSE
                  WRITE (UNIT=LU6, FMT=9640) IREC, TKWD(IREC)
                ENDIF
  610         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 530
C
C           'P'   Print the current page
C
            ELSEIF (LINE(LB:LB) .EQ. 'P' .AND. LT .EQ. 1) THEN
              HIGH = MIN(LOW+PGSZ-1,NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ,1)
              ENDIF
              DO 630 IREC = LOW, MIN(HIGH,NLINES)
                IF (KAT(1:1) .EQ. 'C') THEN
                  II = KPTR(IREC)
                  TCL = ' '
                  CALL UNDOCL (TCLASS(IREC), TCL)
                  WRITE (UNIT=LU6, FMT=9780) II,
     +                   TCL(1:LENSTR(TCL)),
     +                   STMTS(II)(1:LENSTR(STMTS(II)))
                  ITEMP = KPTR(IREC+1)-KPTR(IREC)-1
                  LTCL = LENSTR(TCL)+3
                  WRITE (UNIT=FORM, FMT=9790) LTCL
                  DO 620 JJ = 1, ITEMP
                    II = II + 1
                    WRITE (UNIT=LU6, FMT=FORM) II,
     +                     STMTS(II)(1:LENSTR(STMTS(II)))
  620             CONTINUE
                ELSE
                  WRITE (UNIT=LU6, FMT=9640) IREC, TKWD(IREC)
                ENDIF
  630         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 530
C
C           'E'  End the browsing mode
C
            ELSEIF (LINE(LB:LB) .EQ. 'E' ) THEN
              WRITE (UNIT=LU6, FMT=9040)
              REWIND (UNIT=LU5, ERR=110)
              GO TO 110
C
C           'Q'  Quit the browsing mode
C
            ELSEIF (LINE(LB:LB) .EQ. 'Q' ) THEN
              WRITE (UNIT=LU6, FMT=9040)
              REWIND (UNIT=LU5, ERR=110)
              GO TO 110
            ELSEIF (LINE(LB:LB) .EQ. '?' ) THEN
              GO TO 520
            ELSE
              WRITE (UNIT=LU6, FMT=9050)
              GO TO 520
            ENDIF
  640       WRITE (UNIT=LU6, FMT=9050)
            GO TO 520
          ELSEIF (LINE(LB:LB).EQ.'t' .OR. LINE(LB:LB).EQ.'T') THEN
C
C           Write it to the standard output file.
C
            IF (KAT(1:1) .EQ. 'C') THEN
              DO 660 J = 1,NCC
                I = KPTR(J)
                TCL = ' '
                CALL UNDOCL (TCLASS(J), TCL)
                WRITE (UNIT=LU6, FMT=9810)
     +                 TCL(1:LENSTR(TCL)),
     +                 STMTS(I)(1:LENSTR(STMTS(I)))
                ITEMP = KPTR(J+1)-KPTR(J)-1
                LTCL = LENSTR(TCL)+1
                WRITE (UNIT=FORM, FMT=9820) LTCL
                DO 650 JJ = 1, ITEMP
                  I = I + 1
                  WRITE (UNIT=LU6, FMT=FORM)
     +                   STMTS(I)(1:LENSTR(STMTS(I)))
  650           CONTINUE
  660         CONTINUE
            ELSE
              DO 670 I = 1,NTKWD
                WRITE (UNIT=LU6, FMT=9010) TKWD(I)
  670         CONTINUE
            ENDIF
          ELSEIF (LINE(LB:LB).EQ.'f' .OR. LINE(LB:LB).EQ.'F') THEN
            LS = LB+LT
            CALL CHARIN (LINE(LS:LS), LENG, 2, LB, LT)
            IF (LT .EQ. 0) THEN
C
C             Write it to file FNAME.
C
              FN = FNAME
            ELSE
              FN = LINE(LS-1+LB:LS-1+LB+LT-1)
C
C             Write it to the file he/she specified.
C
            ENDIF
C           IF (FN .NE. FNAMSV) THEN
C
C             If this filename is not the one previously used for some
C             list, then close the file (if it is still open) and open
C             UNIT 13 for the new file.
C
              IF (LLU13) CLOSE (LU13)
              OPEN (UNIT=LU13, FILE=FN, STATUS='UNKNOWN',
     +              FORM='FORMATTED')
              FNAMSV = FN
              LLU13 = .TRUE.
C           ENDIF
C
C           Write the list to the file specified by the user.
C
            IF (KAT(1:1) .EQ. 'C') THEN
              DO 690 J = 1,NCC
                I = KPTR(J)
                TCL = ' '
                CALL UNDOCL (TCLASS(J), TCL)
                WRITE (UNIT=LU13, FMT=9810)
     +              TCL(1:LENSTR(TCL)),
     +              STMTS(I)(1:LENSTR(STMTS(I)))
                ITEMP = KPTR(J+1)-KPTR(J)-1
                LTCL = LENSTR(TCL)+1
                WRITE (UNIT=FORM, FMT=9820) LTCL
                DO 680 JJ = 1, ITEMP
                  I = I + 1
                  WRITE (UNIT=LU13, FMT=FORM)
     +                STMTS(I)(1:LENSTR(STMTS(I)))
  680           CONTINUE
  690         CONTINUE
            ELSE
              DO 700 I = 1,NTKWD
                WRITE (UNIT=LU13, FMT=9010) TKWD(I)
  700         CONTINUE
            ENDIF
            CLOSE(LU13)
          ELSE
            WRITE (UNIT=LU6, FMT=9040)
            REWIND (UNIT=LU5, ERR=110)
            GO TO 110
          ENDIF
          IF (LB.GT.0 .AND. (LINE(LB:LB).EQ.'Q'.OR.LINE(LB:LB).EQ.'E'))
     +      THEN
C
C           The command typed in is assumed to be "quit" or "end".
C
            INPUT1 = 'Q'
          ELSEIF (LB.GT.0 .AND.
     +            (LINE(LB:LB).EQ.'H'.OR.LINE(LB:LB).EQ.'?')) THEN
C
C           The command typed in is assumed to be "help" or "?".
C           Go back and print the original input instructions.
C
            INPUT1 = 'H'
          ELSE
C
C           Print "invalid command" and assume the command was "help".
C
            INPUT1 = 'H'
          ENDIF
        ELSE
C
C         The input command was X.
C
C         User wants documentation for a specific routine.
C
          IF (.NOT.LLU18) THEN
C
C           Read in the information from file FTBL.
C
            LFTBL = 0
  710       CONTINUE
            LFTBL = LFTBL+1
            READ (UNIT=LU18, FMT=9000, END=720) LINESV
            IF (LFTBL .GT. MXNRN) THEN
              MSG = 'MXNRN internal error.  Please contact the '
     +              // 'consulting office.'
              NERR = 2
              GO TO 940
            ENDIF
            READ (UNIT=LINESV, FMT=9310) CAT(LFTBL), RTNAME(LFTBL),
     +            IS(LFTBL), IE(LFTBL), IPS(LFTBL), IPE(LFTBL)
            GO TO 710
  720       CONTINUE
            LFTBL = LFTBL - 1
            LLU18 = .TRUE.
            CLOSE (LU18)
          ENDIF
          LS = LT+LB
          CALL CHARIN (LINE(LS:LS), LENG, 2, LB, LT)
          TEMP = ' '
          IF (LT .EQ. 0) THEN
C
C           Ask the user for the routine name.
C
            WRITE (UNIT=LU6, FMT=9400)
            REWIND (UNIT=LU5, ERR=730)
  730       READ (UNIT=LU5, FMT=9000, END=740) LINE
            CALL UPCASE (LINE, LINE)
            GO TO 750
  740       LINE = ' '
  750       LENG = LENSTR(LINE)
            IF (LENG .EQ. 0) GO TO 770
            TEMP = LINE(1:LENG)
          ELSE
C
C           The routine name was given on the input command line.
C
            TEMP = LINE(LS-1+LB:LS-1+LB+LT-1)
          ENDIF
          RTNIN = TEMP
          DO 760 I = 1,LFTBL
            IF (RTNIN .EQ. RTNAME(I)) GO TO 780
  760     CONTINUE
  770     WRITE (UNIT=LU6, FMT=9440)
C
C         This routine does not exist in the library.
C
          GO TO 100
  780     CONTINUE
C
C         IS(I) contains the location of the subprogram statement.
C         IE(I) contains the location of the END PROLOGUE statement.
C         IPS(I) contains the starting location of the PURPOSE section.
C         IPE(I) contains the ending location of the PURPOSE section.
C
          NUM = IE(I)-IS(I)+1
C
C         Write the name of the routine and the number of lines of
C         documentation.
C
          WRITE (UNIT=LU6, FMT=9410) RTNIN, NUM
C
C         Write the purpose of the subprogram.
C
          DO 790 IREC = IPS(I), IPE(I)
            READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
            WRITE (UNIT=LU6, FMT=9010) LINE
  790     CONTINUE
          FNAME = FLIS
          ILEN = LENSTR(FNAME)
          WRITE (UNIT=LU6, FMT=9420) FNAME(1:ILEN)
C
C         Ask where he/she wants the documentation information written.
C
          WRITE (UNIT=LU6, FMT=9430)
          READ (UNIT=LU5, FMT=9000) LINE
          LENG = LENSTR(LINE)
          CALL CHARIN (LINE, LENG, 2, LB, LT)
C
C         The user wants to browse through the documentation on her/his
C         terminal.
C
          IF (LINE(LB:LB).EQ.'b' .OR. LINE(LB:LB).EQ.'B') THEN
            PGSZ = 21
            LOW = 1
            HIGH = PGSZ
  800       WRITE (UNIT=LU6, FMT=9450)
  810       READ (UNIT=LU5, FMT=9000, END=800) LINE
            LENG = LENSTR(LINE)
            CALL UPCASE (LINE, LINE)
            CALL CHARIN (LINE, LENG, 2, LB, LT)
C
C           'SPGSZ'   Set page size
C
            IF (LINE(LB:LB+4) .EQ. 'SPGSZ') THEN
              IF ((LT .EQ. 5) .AND. (LB+4 .EQ. LENG)) THEN
C
C               Print out the current value of PGSZ
C
                WRITE (UNIT=LU6, FMT=9490) PGSZ
              ELSE
C
C               Get a new pgsz
C
                IF (LT+LB-1 .GT. LB+4) THEN
C
C                 There are no spaces between 'spgsz' and a value
C
                  WRITE (FORM, 9460) LT-5
                  READ (LINE(LB+5:LB+LT-1), FORM, ERR=870) PGSZ
                  PGSZ = ABS(PGSZ)
                ELSE
C
C                 There are spaces; call CHARIN again to get the next
C                 field
C
                  LS = LB+LT
                  CALL CHARIN (LINE(LS:LS), LENG, 2, LB2, LT2)
                  WRITE (FORM, 9460) LENG-LS-LB2+2
                  READ (LINE(LS+LB2-1:LENG), FORM,
     +                  ERR=870) PGSZ
                  PGSZ = ABS(PGSZ)
                ENDIF
                WRITE (UNIT=LU6, FMT=9500) PGSZ
              ENDIF
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 810
C
C           'PD'   Page forwards (downward)
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'PD') THEN
              IF ((LT .EQ. 2) .AND. (LB+1 .EQ. LENG)) THEN
C
C               There is no value given; assume one (1).
C
                NPD = 1
              ELSE
                IF (LT+LB-1 .GT. LB+1) THEN
C
C                 There are no spaces between 'pd' and a value
C
                  WRITE (FORM, 9460) LT-2
                  READ (LINE(LB+2:LB+LT-1), FORM, ERR=870) NPD
                ELSE
C
C                 There are spaces; call CHARIN again to get the next
C                 field
C
                  LS = LB+LT
                  CALL CHARIN (LINE(LS:LS), LENG, 2, LB2, LT2)
                  WRITE (FORM, 9460) LENG-LS-LB2+2
                  READ (LINE(LS+LB2-1:LENG), FORM,
     +                  ERR=870) NPD
                ENDIF
              ENDIF
              LOW = MAX(HIGH+(NPD-1)*PGSZ+1, 1)
              NLINES = IE(I) - IS(I) + 1
              HIGH = MIN(LOW + PGSZ-1, NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ+1,1)
              ENDIF
              DO 820 IREC = IS(I)+LOW-1,
     +                       MIN(IS(I)+HIGH-1,IE(I))
                READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
                WRITE (UNIT=LU6, FMT=9480) IREC-IS(I)+1, LINE
  820         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 810
C
C           'PU'   Page backwards (upward)
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'PU') THEN
              IF ((LT .EQ. 2) .AND. (LB+1 .EQ. LENG)) THEN
C
C               There is no value given; assume one (1).
C
                NPD = 1
              ELSE
                IF (LT+LB-1 .GT. LB+1) THEN
C
C                 There are no spaces between 'pu' and a value
C
                  WRITE (FORM, 9460) LT-2
                  READ (LINE(LB+2:LB+LT-1), FORM, ERR=870) NPD
                ELSE
C
C                 There are spaces; call CHARIN again to get the next
C                 field
C
                  LS = LB+LT
                  CALL CHARIN (LINE(LS:LS), LENG, 2, LB2, LT2)
                  WRITE (FORM, 9460) LENG-LS-LB2+2
                  READ (LINE(LS+LB2-1:LENG), FORM,
     +                  ERR=870) NPD
                ENDIF
              ENDIF
              NPD = -NPD
              LOW = MAX(LOW + NPD*PGSZ, 1)
              NLINES = IE(I) - IS(I) + 1
              HIGH = MIN(LOW + PGSZ-1, NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ+1,1)
              ENDIF
              DO 830 IREC = IS(I)+LOW-1,
     +                       MIN(IS(I)+HIGH-1,IE(I))
                READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
                WRITE (UNIT=LU6, FMT=9480) IREC-IS(I)+1, LINE
  830         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 810
C
C           'HD'   Page half a page forward
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'HD') THEN
              LOW = MAX(LOW + PGSZ/2, 1)
              NLINES = IE(I) - IS(I) + 1
              HIGH = MIN(LOW + PGSZ-1,NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ+1,1)
              ENDIF
              DO 840 IREC = IS(I)+LOW-1,
     +                       MIN(IS(I)+HIGH-1,IE(I))
                READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
                WRITE (UNIT=LU6, FMT=9480) IREC-IS(I)+1, LINE
  840         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 810
C
C           'HU'   Page half a page backward
C
            ELSEIF (LINE(LB:LB+1) .EQ. 'HU') THEN
              LOW = MAX (LOW - PGSZ/2, 1)
              NLINES = IE(I) - IS(I) + 1
              HIGH = MIN(LOW + PGSZ-1,NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ+1,1)
              ENDIF
              DO 850 IREC = IS(I)+LOW-1,
     +                       MIN(IS(I)+HIGH-1,IE(I))
                READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
                WRITE (UNIT=LU6, FMT=9480) IREC-IS(I)+1, LINE
  850         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 810
C
C           'P'   Print the current page
C
            ELSEIF (LINE(LB:LB) .EQ. 'P' .AND. LT .EQ. 1) THEN
              NLINES = IE(I) - IS(I) + 1
              HIGH = MIN(LOW+PGSZ-1,NLINES)
              IF (LOW .GT. HIGH .OR. HIGH-LOW+1 .LT. PGSZ) THEN
                LOW = MAX(HIGH-PGSZ+1,1)
              ENDIF
              DO 860 IREC = IS(I)+LOW-1,
     +                       MIN(IS(I)+HIGH-1,IE(I))
                READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
                WRITE (UNIT=LU6, FMT=9480) IREC-IS(I)+1, LINE
  860         CONTINUE
              WRITE (UNIT=LU6, FMT=9470)
              GO TO 810
C
C           'E'  End the browsing mode
C
            ELSEIF (LINE(LB:LB) .EQ. 'E' ) THEN
              WRITE (UNIT=LU6, FMT=9040)
              REWIND (UNIT=LU5, ERR=110)
              GO TO 110
C
C           'Q'  Quit the browsing mode
C
            ELSEIF (LINE(LB:LB) .EQ. 'Q' ) THEN
              WRITE (UNIT=LU6, FMT=9040)
              REWIND (UNIT=LU5, ERR=110)
              GO TO 110
            ELSEIF (LINE(LB:LB) .EQ. '?' ) THEN
              GO TO 800
            ELSE
              WRITE (UNIT=LU6, FMT=9050)
              GO TO 800
            ENDIF
  870       WRITE (UNIT=LU6, FMT=9050)
            GO TO 800
          ELSEIF (LINE(LB:LB).EQ.'t' .OR. LINE(LB:LB).EQ.'T') THEN
C
C           Write it to the standard output file.
C
            DO 880 IREC = IS(I), IE(I)
              READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
              WRITE (UNIT=LU6, FMT=9010) LINE
  880       CONTINUE
          ELSEIF (LINE(LB:LB).EQ.'f' .OR. LINE(LB:LB).EQ.'F') THEN
            LS = LB+LT
            CALL CHARIN (LINE(LS:LS), LENG, 2, LB, LT)
            IF (LT .EQ. 0) THEN
              FN = FLIS
C
C             Write it to file FLIS.
C
            ELSE
              FN = LINE(LS-1+LB:LS-1+LB+LT-1)
C
C             Write it to the file he/she specified.
C
            ENDIF
            IF (FN .NE. FNAMSV) THEN
C
C             If this filename is not the one previously used for some
C             documentation, then close the file (if it is still open)
C             and open UNIT 3 for the new file.
C
              IF (LLU13) CLOSE (LU13)
              OPEN (UNIT=LU13, FILE=FN, STATUS='UNKNOWN',
     +              FORM='FORMATTED')
              FNAMSV = FN
              LLU13 = .TRUE.
            ENDIF
C
C           Write the documentation to the file specified by the user.
C
            DO 890 IREC = IS(I), IE(I)
              READ (UNIT=LU17, FMT=9000, REC=IREC) LINE
              WRITE (UNIT=LU13, FMT=9010) LINE
  890       CONTINUE
          ELSE
            WRITE (UNIT=LU6, FMT=9040)
            REWIND (UNIT=LU5, ERR=110)
            GO TO 110
          ENDIF
        ENDIF
      ELSE
        IF (LB.GT.0 .AND. (LINE(LB:LB).EQ.'Q'.OR.LINE(LB:LB).EQ.'E'))
     +    THEN
C
C         The command typed in is assumed to be "quit" or "end".
C
          INPUT1 = 'Q'
        ELSEIF (LB.GT.0 .AND.
     +          (LINE(LB:LB).EQ.'H'.OR.LINE(LB:LB).EQ.'?')) THEN
C
C         The command typed in is assumed to be "help" or "?".
C         Go back and print the original input instructions.
C
          INPUT1 = 'H'
        ELSE
C
C         Print "invalid command" and assume the command was "help".
C
          WRITE (UNIT=LU6, FMT=9050)
          INPUT1 = 'H'
        ENDIF
      ENDIF
      IF (INPUT1 .EQ. 'H') THEN
C
C       Go back to the beginning and print the original instructions.
C
        GO TO 90
      ELSE
        IF (INPUT1 .NE. 'Q') THEN
C
C         Print "Ready for your command" and then go process the new
C         request.
C
          WRITE (UNIT=LU6, FMT=9040)
          REWIND (UNIT=LU5, ERR=900)
  900     READ (UNIT=LU5, FMT=9000, END=910) LINE
          CALL UPCASE (LINE, LINE)
          GO TO 920
  910     LINE = ' '
  920     LENG = LENSTR(LINE)
          CALL CHARIN (LINE, LENG, 2, LB, LT)
          GO TO 140
        ELSE
C
C         Close any files still open and terminate.
C
          IF (LLU13) CLOSE (UNIT=LU13)
C         CLOSE (UNIT=LU5)
C         CLOSE (UNIT=LU6)
          CLOSE (UNIT=LU17)
          GO TO 930
        ENDIF
      ENDIF
  930 STOP
  940 CONTINUE
C     OPEN (UNIT=I1MACH(4), FILE=FERR, FORM='FORMATTED',
C    +      STATUS='UNKNOWN')
      CALL XERMSG (' ', 'SLADOC', MSG, NERR, 1)
      STOP
C
 9000 FORMAT (A)
 9010 FORMAT (' ', A)
 9020 FORMAT (' The first field of a command line is required, but' /
     +        ' the second field is optional.  For example, to view' /
     +        ' the main classification categories, just type ''l''.' /
     +        ' Other commands are:' //
     +        ' x,abc  to extract the documentation by name, where' /
     +        '           ''abc'' is a routine name' /
     +        ' k,...  to find routine names by keyword(s), where' /
     +        '           ''...'' is a keyword or keyphrase' /
     +        ' c,xyz  to find routine names by classification ',
     +        'category,' /
     +        '           where ''xyz'' is a classification category' /
     +        ' l,c    to list subcategories of a main category, where'
     +        /
     +        '           ''c'' is a main classification category' /
     +        ' v,xyz  to view the list of keywords or the ',
     +        'classification'/
     +        '           scheme, where ''abc'' is K for the keywords'
     +        ' or C'/
     +        '           for the classification scheme'/
     +        ' q      to quit')
 9030 FORMAT (/ ' Ready for your command')
 9040 FORMAT (/ ' Ready for your command {x, k, c, l, v, or q}')
 9050 FORMAT (' Invalid command')
 9100 FORMAT (/ ' The major categories are:')
 9110 FORMAT (/ ' Input a MAJOR category you wish to explore')
 9120 FORMAT (/ ' Type in the SUBCATEGORY you wish to explore, or <cr>')
 9130 FORMAT (/ ' There are no subcategories of: ',A)
 9140 FORMAT (1X)
 9200 FORMAT (/ ' Input classification category for routine names')
 9210 FORMAT (/ ' The routine names classified under the category are')
 9220 FORMAT (' category not found')
 9230 FORMAT (/ 1X, A8, ' category does not exist in this library.' /)
 9300 FORMAT (/ ' Input keyword(s) for routine names')
 9310 FORMAT (1X, 2A, 4I8)
 9320 FORMAT (/ ' This keyword was found in the keyword phrase:' /
     +        5X, A)
 9330 FORMAT (/ ' The routine names associated with the keyword(s) are')
 9340 FORMAT (/ ' Keyword not found')
 9400 FORMAT (' Input a routine name for its purpose')
 9410 FORMAT (' ', A, ' ... ', I6, ' lines of documentation')
 9420 FORMAT (/ ' If you wish to see the full documentation,' /
     +        '     type  ''b''          to browse through the ',
     +        'documentation' /
     +        '     type  ''t''          to have it written on your ',
     +        'terminal' /
     +        '     type  ''f,filename'' to have it written on file ',
     +        '''filename''' /
     +        '     type  ''f         '' to have it written on file ',
     +        '''', A, '''')
 9430 FORMAT (' If you do not wish to see the full documentation,' /
     +        '     type anything else')
 9440 FORMAT (' Routine name not found')
 9450 FORMAT (' The browsing commands are:' /
     +        '     type  ''p''            to display the current ',
     +        'page', /
     +        '     type  ''pd''           to display the next page', /
     +        '     type  ''pd {+-}[n]''   to display the {+-}[n]-th ',
     +        'page down', /
     +        '     type  ''pu''           to display the preceeding ',
     +        'page', /
     +        '     type  ''pu {+-}[n]''   to display the {+-}[n]-th ',
     +        'page up', /
     +        '     type  ''spgsz''        to show the current page ',
     +        'size', /
     +        '     type  ''spgsz [n]''    to set page size to [n] ',
     +        'lines', /
     +        '     type  ''hd''           to display one-half page ',
     +        'down (forward)', /
     +        '     type  ''hu''           to display one-half page ',
     +        'up (backward)', /
     +        '     type  ''e''            to exit browsing mode', /
     +        '     type  ''q''            to quit browsing mode')
 9460 FORMAT ('(I',I2,')')
 9470 FORMAT (/ ' Enter your next browsing command',
     +           ' {spgsz p pd pu hd hu e q}')
 9480 FORMAT (' ', I4, 2X, 72A)
 9490 FORMAT (/, ' The current value of PGSZ is: ', I5)
 9500 FORMAT (/, ' The new value of PGSZ is: ', I5)
 9600 FORMAT (/ ' Input C for classification scheme or K for keywords')
 9610 FORMAT (' ', A, ' list ', I6, ' lines ')
 9620 FORMAT (/ ' If you wish to view these,' /
     +        '     type  ''b''          to browse through the ',
     +        'list' /
     +        '     type  ''t''          to have it written on your ',
     +        'terminal' /
     +        '     type  ''f,filename'' to have it written on file ',
     +        '''filename''' /
     +        '     type  ''f         '' to have it written on file ',
     +        '''', A, '''')
 9630 FORMAT (' If you do not wish to view these,' /
     +        '     type anything else')
 9640 FORMAT (' ', I4, 2X, A)
 9700 FORMAT (I5, 2X, I5)
 9710 FORMAT (I15)
 9720 FORMAT (2I2)
 9730 FORMAT (3I5, 3X, A)
 9740 FORMAT ('(1X, A', I2, ', A)')
 9750 FORMAT ('(A', I2, ')')
 9760 FORMAT ((1X, 6(A, 2X)))
 9780 FORMAT (1X, I4, 2X, A, 1X, A)
 9790 FORMAT ('(1X, I4, ', I2, 'X, A)')
 9810 FORMAT (1X, A, 1X, A)
 9820 FORMAT ('(1X, ', I2, 'X, A)')
      END
*DECK CHARIN
      SUBROUTINE CHARIN (CARDIN, LCARD, IOPT, LB, LT)
C***BEGIN PROLOGUE  CHARIN
C***SUBSIDIARY
C***PURPOSE  Subsidiary to SLADOC
C***LIBRARY   (NONE)
C***AUTHOR  Chow, Jeff, C-10, Los Alamos National Laboratory
C***DESCRIPTION
C
C   Locate a phrase terminated by a comma or a blank.
C
C***SEE ALSO  SLADOC
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   870827  DATE WRITTEN
C   891208  Changed to check only for a blank or comma.
C   891208  Prologue converted to Version 4.0 format.  (BAB)
C   920911  Declarations section restructured.  (WRB)
C***END PROLOGUE  CHARIN
C     .. Parameters ..
      INTEGER LAST
      PARAMETER (LAST = 2)
C     .. Scalar Arguments ..
      INTEGER IOPT, LB, LCARD, LT
      CHARACTER*(*) CARDIN
C     .. Local Scalars ..
      INTEGER I, L, L1, L2, L3, L9, LBP1, LE, MATCH
      CHARACTER*2 SPECIA
C     .. Data statements ..
      DATA SPECIA /' ,'/
C***FIRST EXECUTABLE STATEMENT  CHARIN
      IF (IOPT .NE. 2) THEN
        L1 = LCARD
        L2 = 1
        L3 = -1
        L9 = 1
      ELSE
        L1 = 1
        L2 = LCARD
        L3 = 1
        L9 = LAST
      ENDIF
      LB = 0
      DO 30 I = L1,L2,L3
        MATCH = 0
        DO 10 L = 1,L9
          IF (CARDIN(I:I) .EQ. SPECIA(L:L)) THEN
            MATCH = L
            GO TO 20
          ENDIF
   10   CONTINUE
   20   IF (MATCH .EQ. 0) THEN
          LB = I
          GO TO 40
        ENDIF
   30 CONTINUE
   40 IF (IOPT .EQ. 2) THEN
        IF (LB .GT. 0) THEN
          IF (LB .EQ. LCARD) THEN
            LT = 1
            RETURN
          ELSE
            LE = LCARD
            LBP1 = LB+1
            DO 70 I = LBP1,LCARD
              MATCH = 0
              DO 50 L = 1,L9
                IF (CARDIN(I:I) .EQ. SPECIA(L:L)) THEN
                  MATCH = L
                  GO TO 60
                ENDIF
   50         CONTINUE
   60         IF (MATCH .NE. 0) THEN
                LE = I-1
                GO TO 80
              ENDIF
   70       CONTINUE
   80       LT = LE-LB+1
          ENDIF
        ELSE
          LT = 0
        ENDIF
      ELSE
        IF (LB .GT. 0) THEN
          LT = LB
        ELSE
          LT = 1
        ENDIF
        LB = 1
      ENDIF
      RETURN
      END
*DECK MINOR
      INTEGER FUNCTION MINOR (KAT, KATS, NCC, TCLASS, IPTR, JPTR, KPTR,
     +   NTRY)
C***BEGIN PROLOGUE  MINOR
C***SUBSIDIARY
C***PURPOSE  Subsidiary to SLADOC
C***LIBRARY   (NONE)
C***AUTHOR  Bacon, Barbara A., C-10, Los Alamos National Laboratory
C***DESCRIPTION
C
C   Function to locate all the subcategories of a given category in the
C   SLATEC library.
C
C***SEE ALSO  SLADOC
C***ROUTINES CALLED  FIND, UNDOCL
C***REVISION HISTORY  (YYMMDD)
C   871201  DATE WRITTEN
C   891208  Prologue converted to Version 4.0 format.  (BAB)
C   920911  Declarations section restructured.  (WRB)
C***END PROLOGUE  MINOR
C     .. Parameters ..
      INTEGER IALPHA
      PARAMETER (IALPHA = 26)
C     .. Scalar Arguments ..
      INTEGER NCC,NTRY
      CHARACTER*(*) KAT, KATS
C     .. Array Arguments ..
      INTEGER IPTR(NCC), JPTR(NCC), KPTR(NCC)
      CHARACTER*(*) TCLASS(NCC)
C     .. Arrays in Common ..
      INTEGER I1(IALPHA), I2(IALPHA), I3(IALPHA), LMSG(IALPHA)
      CHARACTER*7 CLASS(IALPHA)
C     .. Local Scalars ..
      INTEGER IFIND
C     .. External Functions ..
      INTEGER FIND
      EXTERNAL FIND
C     .. External Subroutines ..
      EXTERNAL UNDOCL
C     .. Common blocks ..
      COMMON /CATGRY/ I1, I2, I3, LMSG
      COMMON /KLASS/ CLASS
C***FIRST EXECUTABLE STATEMENT  MINOR
      MINOR = 0
      IFIND = FIND(TCLASS,NCC,KAT)
      IF (IFIND .LE. 0) THEN
        MINOR = 1
        NTRY = 0
        RETURN
      ENDIF
C
      NTRY = 1
      CLASS(NTRY) = KATS
      LMSG(NTRY) = KPTR(IFIND+1)-KPTR(IFIND)
      I3(NTRY) = KPTR(IFIND)
      IFIND = JPTR(IFIND)
   10 IF (IFIND .GT. 0) THEN
        NTRY = NTRY+1
        I1(NTRY) = IPTR(IFIND)
        I2(NTRY) = JPTR(IFIND)
        I3(NTRY) = KPTR(IFIND)
        CLASS(NTRY) = ' '
        CALL UNDOCL (TCLASS(IFIND), CLASS(NTRY))
        LMSG(NTRY) = KPTR(IFIND+1)-KPTR(IFIND)
        IFIND = IPTR(IFIND)
        GO TO 10
      ELSE
        RETURN
      ENDIF
      END
*DECK RBLNKS
      SUBROUTINE RBLNKS (L1, L2)
C***BEGIN PROLOGUE  RBLNKS
C***SUBSIDIARY
C***PURPOSE  Remove leading blanks from a character string.
C***LIBRARY   (NONE)
C***AUTHOR  Bacon, Barbara A., C-10, Los Alamos National Laboratory
C***DESCRIPTION
C
C   Subroutine to remove leading blanks from a character string
C
C***SEE ALSO  SLADOC
C***ROUTINES CALLED  LENSTR
C***REVISION HISTORY  (YYMMDD)
C   871201  DATE WRITTEN
C   891208  Prologue converted to Version 4.0 format.  (BAB)
C   920911  Declarations section restructured.  (WRB)
C***END PROLOGUE  RBLNKS
C     .. Scalar Arguments ..
      CHARACTER*80 L1, L2
C     .. Local Scalars ..
      INTEGER I, J, K, LENG
C     .. External Functions ..
      INTEGER LENSTR
      EXTERNAL LENSTR
C***FIRST EXECUTABLE STATEMENT  RBLNKS
      LENG = LENSTR(L1)
      DO 10 I = 1,LENG
        IF (L1(I:I) .NE. ' ') GO TO 20
   10 CONTINUE
C
C     We found a completely blank line.
C
      L2 = ' '
      RETURN
   20 CONTINUE
      L2 = ' '
      K = 1
C
C     Remove leading blanks in the line.
C
      DO 30 J = I,LENG
        L2(K:K) = L1(J:J)
        K = K+1
   30 CONTINUE
      RETURN
      END
*DECK UNDOCL
      SUBROUTINE UNDOCL (KAT, CAT)
C***BEGIN PROLOGUE  UNDOCL
C***SUBSIDIARY
C***PURPOSE  Subsidiary to SLADOC
C***LIBRARY   (NONE)
C***AUTHOR  Bacon, Barbara A., C-10, Los Alamos National Laboratory
C***DESCRIPTION
C
C   Subroutine to collapse a GAMS category name by removing the
C   zero before a numerical part.
C   E.G., D02D01A   becomes   D2D1A
C
C***SEE ALSO  SLADOC
C***ROUTINES CALLED  (NONE)
C***REVISION HISTORY  (YYMMDD)
C   871201  DATE WRITTEN
C   891208  Prologue converted to Version 4.0 format.  (BAB)
C   920911  Declarations section restructured.  (WRB)
C***END PROLOGUE  UNDOCL
C     .. Scalar Arguments ..
      CHARACTER*(*) CAT, KAT
C     .. Local Scalars ..
      INTEGER IC, IK, LENG, WENY
C     .. External Functions ..
      INTEGER LENSTR
      EXTERNAL LENSTR
C***FIRST EXECUTABLE STATEMENT  UNDOCL
      LENG = LENSTR(KAT)
      WENY = 1
      IK = 1
      IC = 1
   10 IF (WENY .EQ. 1) THEN
        CAT(IC:IC) = KAT(IK:IK)
        IC = IC+1
        IK = IK+WENY
      ELSE
        IF (KAT(IK:IK) .EQ. '0') THEN
          CAT(IC:IC) = KAT(IK+1:IK+1)
          IC = IC+1
          IK = IK+WENY
        ELSE
          CAT(IC:IC+1) = KAT(IK:IK+1)
          IC = IC+2
          IK = IK+WENY
        ENDIF
      ENDIF
      WENY = 3-WENY
      IF (IK .LE. LENG) GO TO 10
      RETURN
      END
