C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C*****************************
C**     KWD_CHK_PARSEKDM    **
C*****************************
C
CD-Routine: Parse KDM Data with Additional Checking - KWD_CHK_PARSEKDM
C This routine is similar to KWD_PARSEKDM but a user supplied routine may make 
C an additional check on each KDM parameter and disable its update if
C desired.
CD-end
CD-Fortran:
      SUBROUTINE KWD_CHK_PARSEKDM (KDX, LINE, PGM_CHK, IFLAG, BADTOK, 
     +                             ERRSTR)
CD-end
      INCLUDE 'implicit_none.finc'
C
C Purpose: Parse line for KDM data and store any found.
C
C Author:  John W. Campbell, May 1993
C
C Arguments:
C
      INTEGER KDX
      CHARACTER*(*) LINE
      EXTERNAL PGM_CHK
      INTEGER IFLAG
      CHARACTER*(*) BADTOK
      CHARACTER*(*) ERRSTR

CD-Parameters:
C KDX      i (R)   Index to required KDM data set.
C LINE     c (R)   Character string containing line to be parsed
C                  (Assume comments & continuations already removed)
C PGM_CHK  s (R)   Subroutine to make additional check on KDM parameters
C                  to restrict updates (or return other information to 
C                  calling program about the parameters found via common 
C                  blocks)
C
C                  The call will be as follows: CALL PGM_CHK (KEYWORD, OK)    
C
C                  KEYWORD   (R) CHARACTER*(*) variable holding the full
C                                name of the KDM parameter.
C                  OK        (W) Logical flag; return .TRUE. if parameter
C                                may be updated or .FALSE. if it may not.
C
C IFLAG    i (W)   Return flag = 0,  KDM data found & OK
C                              = 1,  Not KDM data
C                              = 2,  No non-blank tokens of requested set
C                              < 0,  KDM data but error(s)
C                              =-1,  Invalid or inappropriate set 
C                                    specification
C                              =-2,  Invalid or inappropriate subset 
C                                    specification
C                              =-3,  Syntax error in set/subset 
C                                    specification
C                              =-4,  Invalid value 
C                              =-5,  Non-KDM data mixed with KDM data
C                                    (Possibly miss-spelt keyword)
C                             -100,  Coding error in KWD routines, 
C                                    information supposedly already 
C                                    checked is found later to be invalid!
C BADTOK   c (W)   Returns the token string for an invalid token
C ERRSTR   c (W)   Error string (max 80 chars) if IFLAG<0
CD-end
C
C====== Parameter statements
C 

C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C
      INTEGER NXTTOK
      INTEGER LENSTR
      INTEGER KDMSTR
C
C====== LOCALS:
C
      LOGICAL OK
      INTEGER I
      INTEGER LL
      INTEGER IL
      INTEGER M1
      INTEGER M2
      INTEGER II
      INTEGER MDUM
      INTEGER ITYP
      INTEGER IERR
      INTEGER ISET
      INTEGER NVALS
      INTEGER ISUBSET
      INTEGER ISS
      INTEGER IPAR
      INTEGER IVAL(2)
      REAL FVAL(2)
      CHARACTER*50 KEYWORD
      CHARACTER*50 FULLNAME
      CHARACTER*4 SEP

C     LOGICAL OK           !OK to update parameter flag
C     INTEGER I            !Return flag from NXTTOK routine
C     INTEGER LL           !Length of input line
C     INTEGER IL           !Last character accessed in line being parsed
C     INTEGER M1           !First character in token field
C     INTEGER M2           !Final character in token field
C     INTEGER II           !Temp/loop variable
C     INTEGER MDUM         !Dummy character position index
C     INTEGER ITYP         !KDM parameter type flag from KDMF_CHECKPAR
C     INTEGER IERR         !Error flag
C     INTEGER ISET         !Set number decoded from KDM keyword (0=all sets)
C     INTEGER NVALS        !No. of integer/float values
C     INTEGER ISUBSET      !Subset number decoded from KDM keyword (0=all 
C                           subsets)
C     INTEGER ISS          !Dataset/set/subset specific parameter flag 0/1/2
C     INTEGER IPAR         !Parameter no. in KDM data set
C     INTEGER IVAL(2)      !Dummy integer value array
C     REAL FVAL(2)         !Dummy real value array
C     CHARACTER*50 FULLNAME!Full parameter name
C     CHARACTER*4 SEP      !Token separator characters

      DATA SEP /'  ,='/
C
C-------------------------------------------------------------------------------
C
      IFLAG = 2
      SEP(2:2) = CHAR(9)
      BADTOK = ' '
      IL = 0
      LL = LEN(LINE)
C
C====== Get next token
C
100   I = NXTTOK (LINE, SEP, IL, M1, M2)
      IF (I.EQ.-1) RETURN
      IF (I.EQ.0) GO TO 100
C
C====== See if KDM  parameter name
C
      CALL KWD_PARSEITEM (LINE(M1:M2), KEYWORD, ISET, ISUBSET, ISS, 
     +                    IERR)
      IF (IERR.EQ.0) CALL KDMF_CHECKPAR (KDX, KDMSTR(KEYWORD), 
     +                                   LENSTR(KEYWORD),
     +                                   ISET, ISUBSET, ISS,
     +                                   KDMSTR(FULLNAME), 50, 
     +                                   ITYP, NVALS, IPAR, IERR)
      CALL PGM_CHK (FULLNAME, OK)
      IF (IERR.LE.0) THEN
         IFLAG = 0
         IF (IERR.LT.0) THEN
            BADTOK = LINE(M1:M2)
            IFLAG = IERR 
            IF (IERR.EQ.-1) 
     +         ERRSTR = 'Invalid or inappropriate set specification'
            IF (IERR.EQ.-2) 
     +         ERRSTR = 'Invalid or inappropriate subset specification'
            IF (IERR.EQ.-3) 
     +         ERRSTR = 'Syntax error in set/subset specification'
            RETURN
         END IF
         I = NXTTOK (LINE, SEP, IL, M1, M2)
         IF (I.LE.0) THEN
            IF (OK) THEN
               CALL KDMF_RESET (KDX,  KDMSTR(FULLNAME), 
     +                         LENSTR(FULLNAME),
     +                         ISET, ISUBSET, KDMSTR(ERRSTR), 
     +                         LEN(ERRSTR), IERR)
               IF (IERR.LT.0) THEN
                  IFLAG = IERR
C
C====== Note: IERR=-3 should not occur as keyword already checked
C
                  IF (IERR.EQ.-3) IFLAG = -100
                  RETURN
               END IF
            END IF
            IF (I.LT.0) RETURN
         ELSE
            IF (ITYP.GT.9) THEN
                   M2 = LL
                   IL = LL
            END IF
            IF (ITYP.LT.7.AND.NVALS.GT.1) THEN
               DO 120 II = 2, NVALS
                  I = NXTTOK (LINE, SEP, IL, MDUM, M2)
                  IF (I.LE.0) THEN
                     ERRSTR = 'Too few values given for the parameter'
                     IFLAG = -4
                     RETURN
                  END IF
 120           CONTINUE
            END IF
            IF (OK) THEN
               CALL KDMF_SETVALUE (KDX, KDMSTR(FULLNAME), 
     +                             LENSTR(FULLNAME),
     +                             ISET, ISUBSET, KDMSTR(LINE(M1:M2)), 
     +                             LENSTR(LINE(M1:M2)), IVAL, FVAL, 0,
     +                             KDMSTR(ERRSTR), LEN(ERRSTR), IERR)
               IF (IERR.GT.0) THEN
                  BADTOK = LINE(M1:M2)
                  IFLAG = - 4
                  RETURN
               END IF
            END IF
         END IF
      ELSE
C
C====== Non-KDM keyword found
C
         IF (IFLAG.EQ.0) THEN
            BADTOK = LINE(M1:M2)
            IFLAG = -5
            ERRSTR = 'Mixed KDM and non-KDM data'
            RETURN
         ELSE
            IFLAG = 1
            RETURN
         END IF
      END IF
      GO TO 100
      END
