C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C**************************
C**     KWD_READSTR      **
C**************************
C
CD-Routine: Handle Indirect File References in a String - KWD_READSTR
C This routine is similar to KWD_READLINE in its handling of indirect files.
C The difference is that the line for examination is passed to the routine
C rather than being read from a top level parameter file.
CD-end
CD-Fortran:
      SUBROUTINE KWD_READSTR (LINE, KUN, INDIRECT, IFLAG, IERR)
CD-end
      INCLUDE 'implicit_none.finc'
C
C Purpose: Read next logical line from a parameters/control file
C
C Author:  John W. Campbell, June 1995 (modified copy from LDM_READSTR)
C
C
C Arguments:
C
      CHARACTER*(*) LINE
      INTEGER KUN
      INTEGER INDIRECT
      INTEGER IFLAG
      INTEGER IERR

CD-Parameters:       
C LINE     c (R/W) On input is the line to be decoded for indirect file
C                  specification. The string should not contain comment or
C                  continuation characters and, if an indirect file
C                  specification is used, then it should only contain that
C                  specification.
C                  On output is the next line read from an
C                  indirect file (or the original line if no indirection
C                  found (or blank if the input line contained '@' only)).
C KUN      i (R)   Start logical unit number for use with indirect files.
C                  Unit nos. (up to MAXIND e.g. 20) in sequence will be 
C                  used but any already open will be skipped.
C INDIRECT i (R/W) Current indirection level. MUST be set to 0 on first 
C                  call to read the file and subsequently must give the 
C                  previously returned value. User should ensure that the 
C                  program repeats calls to the routine until IFLAG or 
C                  INDIRECT are returned as 0 (otherwise files will be 
C                  left open).
C IFLAG    i (W)   Flag = 0, if first call and string does not contain
C                            an indirect file specification. 'LINE' is
C                            returned as input.
C                       = 1, Line read from indirect file
C                       =-1, End of indirect data reached
C IERR     i (W)   Returned error flag = 0 OK
C                                      = 1 LINE too short, data truncated
C                                      = 2 Error opening indirect file
C                                      = 3 Maximum allowed level of 
C                                          indirection exceeded
C                                      = 4 Insufficient Fortran units 
C                                          available for opening indirect 
C                                          files
C                                      = 5 Calling error (invalid INDIRECT 
C                                          value)
C
C                  For error flags > 1, all opened indirect files will be 
C                  closed
C
C Notes:   Allows for indirect reads from specified files up to MAXIND
C          levels (e.g. 20) in depth. 
C
C          Conventions for comments & continuations similar to CCP4 parser
C          but only '!' introduces comments (and not '#'). These only
C          apply to lines read from an indirect file.
C
C          If '@' not followed by a file name is found, then all
C          indirection is cancelled. A blank line will be returned
C          and IFLAG will be returned as 0 (see above)
CD-end
C
C====== Parameter statements
C 
      INTEGER MAXIND
      INTEGER MAXCH
      PARAMETER (MAXIND=20)
      PARAMETER (MAXCH=121)
C
C MAXIND is maximum level of files indirection
C MAXCH is the max. no. of characters in an input record
C
C====== GLOBALS:
C
      COMMON /KWDRS1/ ISTREAM(MAXIND)
      INTEGER ISTREAM

C ISTREAM   Array of unit numbers used for reading indirect files

      CHARACTER*(MAXCH) FILNAM
      COMMON /KWDRS2/ FILNAM

C FILNAM    Holds name of last indirect file opened after an error return
C
C====== FUNCTION TYPES:
C
      INTEGER LENSTR
      INTEGER NXTTOK
      LOGICAL CCPEXS
C
C====== LOCALS:
C
      LOGICAL OPN
      LOGICAL CONT
      LOGICAL TRUNC
      INTEGER LUN
      INTEGER JUN
      INTEGER I
      INTEGER L
      INTEGER LL
      INTEGER LMAX
      INTEGER IFAIL
      INTEGER NCH
      INTEGER IL
      INTEGER M1
      INTEGER M2
      CHARACTER*(MAXCH) LIN
      CHARACTER*4 SEP

C     LOGICAL OPN       !Unit already open flag
C     LOGICAL CONT      !Continuation character found flag
C     LOGICAL TRUNC     !Returned line truncated flag
C     INTEGER LUN       !Unit number for next read, 0 
C     INTEGER JUN       !Unit number for next indirect file
C     INTEGER I         !Loop variable
C     INTEGER L         !Loop variable
C     INTEGER LL        !Length of character string
C     INTEGER LMAX      !Length of LINE
C     INTEGER IFAIL     !File open flag
C     INTEGER NCH       !Character count for LINE
C     INTEGER IL        !Last character position from token extraction
C     INTEGER M1        !Start position of token
C     INTEGER M2        !End position of token
C     CHARACTER*(MAXCH) LIN  !Buffer or reading record
C     CHARACTER*4 SEP        !Field separators
C
C====== SAVES
C
      SAVE /KWDRS1/,/KWDRS2/
C
C====== DATA:
C
      DATA SEP/'  ,='/
C
C-------------------------------------------------------------------------------
C
C====== Initialisations
C
      IFLAG = 0
      IERR = 0
      SEP(2:2) = CHAR(9)
      FILNAM = ' '
C
C====== Initial check for indirection on initial call
C
      IF (INDIRECT.LE.0) THEN
         IL = 0
         I = NXTTOK (LINE,SEP,IL,M1,M2)
         IF (I.LE.0) RETURN
         IF (LINE(M1:M1).NE.'@') RETURN
      END IF
C
C====== Further initialisations
C
      LIN = LINE
      LINE = ' '
      LMAX = LEN(LINE)
      NCH = 0
      TRUNC = .FALSE.
C
C====== Get required stream
C
100   IF (INDIRECT.LE.0) THEN
         INDIRECT = 0
         LUN = 0
      ELSE
         IF (INDIRECT.GT.MAXIND) THEN
            IERR = 5
            RETURN
         END IF
         LUN = ISTREAM(INDIRECT)
      ENDIF
C
C====== Read line from file if indirect file in progress
C
      IF (LUN.GT.0) THEN
         READ (LUN, '(A)', END=200) LIN
C
C====== Line read, remove any comments
C
         IFLAG = 1
         LL = LENSTR(LIN)
         IF (LL.GT.0) THEN
            DO 110 L = 1, LL
               IF (LIN(L:L).EQ.'!') THEN
                  LIN(L:) = ' '
                  GO TO 120
               END IF
110         CONTINUE
         END IF
120      LL = LENSTR(LIN)
      END IF
C
C====== See if indirect file
C
      IL = 0
      I = NXTTOK (LIN,SEP,IL,M1,M2)
      IF (I.GT.0) THEN
         IF (LIN(M1:M1).EQ.'@') THEN
            IF (M2.EQ.M1) THEN
               I = NXTTOK(LIN,SEP,IL,M1,M2)
               IF (I.LE.0) THEN
                  IF (INDIRECT.GT.0) THEN
                     DO 130 I = 1, INDIRECT
                        CLOSE (UNIT=ISTREAM(INDIRECT))
130                  CONTINUE
                  END IF
                  INDIRECT = 0 
                  LINE = ' '
                  IFLAG = -1
                  RETURN
               END IF
            ELSE
               M1 = M1 + 1
            END IF
            IF (INDIRECT.GE.MAXIND) THEN
               IERR = 3
               GO TO 300
            ELSE
               IF (INDIRECT.EQ.0) THEN
                  JUN = KUN - 1
               ELSE
                  JUN = ISTREAM(INDIRECT)
               END IF
               INDIRECT = INDIRECT + 1
140            JUN = JUN + 1
               IF (JUN.GT.99) THEN
                  IERR = 3
                  GO TO 300
               ELSE
                  INQUIRE (UNIT=JUN,OPENED=OPN)
                  IF (OPN) GO TO 140
                  ISTREAM(INDIRECT) = JUN
                  FILNAM = LIN(M1:M2)
                  IF (.NOT.CCPEXS(FILNAM)) THEN
                     IERR = 2
                     GO TO 300
                  END IF
                  IFAIL = 1
                  CALL CCPDPN(-JUN,LIN(M1:M2),'READONLY','F',0,IFAIL)
                  IF (IFAIL.LT.0) THEN
                     IERR = 2
                     GO TO 300
                  ELSE
                    GO TO 100
                  END IF
               END IF
            END IF
         END IF
      END IF
C
C====== Test for continuation character (if read from indirect file)
C
      CONT = .FALSE.
      IF (LUN.GT.0) THEN
         LL = LENSTR(LIN)
         IF (LL.GT.0) THEN
            IF (LIN(LL:LL).EQ.'-'.OR.LIN(LL:LL).EQ.'&') THEN
               LIN(LL:LL) = ' '
               CONT = .TRUE.
            END IF
         END IF
      END IF
C
C====== Add string to LINE
C
      LL = LENSTR(LIN)
      IF (LL.GT.0.AND..NOT.TRUNC) THEN
         IF (LINE.EQ.' ') THEN
            NCH = NCH + LL
            LINE = LIN
         ELSE
            LINE = LINE(1:LENSTR(LINE))//' '//LIN
            NCH = NCH + LL + 1
         END IF
      END IF
      IF (NCH.GT.LMAX) TRUNC = .TRUE.
      IF (CONT) GO TO 100
C
C====== Next logical now complete
C
      IF (TRUNC) IERR = 1
      RETURN
C
C====== End of file conditions
C
200   IF (INDIRECT.GT.0) THEN
         CLOSE (UNIT=ISTREAM(INDIRECT))
         INDIRECT = INDIRECT - 1
         IF (INDIRECT.EQ.0) THEN
            IFLAG = -1
            RETURN
         ELSE
            GO TO 100
         END IF
      END IF
      RETURN
C
C====== Error - close files & return
C
300   IF (INDIRECT.GT.0) THEN
         DO 310 I = 1, INDIRECT
            CLOSE (UNIT=ISTREAM(INDIRECT))
310      CONTINUE
      END IF
      INDIRECT = 0
      IFLAG = -1
      RETURN
      END
