C  2 NOV 05 - MWS - ADD DIRECTIONS IN COMMENTS (NO CODE CHANGES)
C 10 NOV 04 - TI  - SCAN MODE SHOULD IGNORE ANY ARRAY SUBSCRIPT PASSED
C  3 JUN 04 - MWS - FIX SCANNING FOR MORE THAN 5 VALUES
C 19 MAY 04 - DGF - SCANNING MODE OPTION ADDED
C  9 DEC 03 - MWS - SYNCH COMMON BLOCK RUNOPT
C  4 NOV 03 - MWS - QTZVAL: ENSURE LOGICALS ARE ENTERED CORRECTLY
C 26 MAR 02 - MWS - QTZVAL: PERMIT PARENTHESES IN STRING VALUES
C  6 SEP 01 - HU  - INCREASE LIMIT OF NUMBER OF VARIABLES TO 64
C 26 OCT 00 - MWS - USE VARIABLES IN ALL BCAST CALLS
C 12 NOV 98 - MWS - DOUBLE WORD ALIGN REALS IN COMMON QQQQZR
C  6 MAY 98 - MWS - CHANGE -UPCASE- TO -UPRCAS-
C 28 SEP 97 - MWS - CONVERT PARALLEL CALLS FROM TCGMSG TO DDI
C 13 JUN 96 - MWS - REMOVE SOME FTNCHEK WARNINGS
C 11 NOV 94 - MWS - REMOVE SOME FTNCHEK WARNINGS
C 13 DEC 93 - TLW - NAMEIO: ONLY MASTER EVER READS CARD IMAGES
C  5 APR 92 - MWS - USE MSGEST FOR MESSAGE MASKS
C 30 JAN 92 - TLW - PARALLELIZED
C 11 JAN 92 - TLW - NAMEIO,QNZCRD: MAKE READS PARALLEL
C 10 JAN 92 - TLW - CHANGE REWIND TO CALL SEQREW
C  7 JAN 92 - TLW - MAKE WRITES PARALLEL; ADD COMMON PAR
C  4 DEC 91 - STE - USE MORE CHARACTER STRINGS
C 17 APR 91 - MWS - NAMEIO: DON'T CAPITALIZE W/O A $ IN COLUMN 2
C  7 NOV 90 - MWS - QTZVAL: DO DOUBLE PRECISON CORRECTLY.
C 30 OCT 90 - STE - QTZVAL: DO EXPONENT CALC WITHOUT LOOPS
C 12 MAY 90 - MWS - CONVERT CARDS TO UPPER CASE BEFORE SCANNING
C 25 DEC 89 - STE - QNZCRD: DUMMY CALL TO FORCE CORRECT MIPS COMPILE
C 12 JUL 89 - STE - QNZCRD: HIDE EXCLAMATION POINT FROM MIPS COMPILER
C 29 MAR 89 - MWS - VERY MINOR IMPROVEMENTS IN MAIN PROGRAM.
C  7 SEP 88 - STE - ADD ERROR MESSAGE AFTER LOOP 300 IN NAMEIO
C 22 AUG 88 - MWS - IMPROVE (?) THE $ ERROR FLAG DIAGNOSTIC
C 14 NOV 87 - STE - ADD EXETYP=CHECK OPTION
C  5 MAY 87 - STE - DIMENSION QNAME IN NAMEIO
C  3 NOV 86 - STE - DIMENSION CHSTRS IN QVRZC4,QVRZC8
C 22 JUL 86 - MWS - USE INTERNAL FILES FOR CHARACTER PACKING
C 31 OCT 85 - STE - CLEAN UP VARIABLE INITIALIZATION
C 18 FEB 85 - MWS - CHANGE TYPE LOGICAL*1 TO LOGICAL(*4)
C 20 DEC 83 - STE - ALLOW MULTIPLE GROUP NAME RECOGNITIONS
C 16 NOV 83 - STE - CHANGES FOR FPS
C 23 FEB 83 - STE - CHANGE DOLLAR SIGN IN NAMES TO Z
C 24 OCT 82 - MWS - PROVIDE 8-BYTE STORAGE FOR ARGUMENTS D1-D32 IN
C                   NAMEIO, X IN QVRTZQ - THESE ARE ALSO MADE ARRAYS (1)
C  3 OCT 82 - MWS - CONVERT FOR IBM
C
C*MODULE NAMEIO  *DECK NAMEIO
      SUBROUTINE NAMEIO(NFA,JRET,GROUP,NOITMS,Q,KQ,
     *              D1, D2, D3, D4, D5, D6, D7, D8, D9,
     *         D10,D11,D12,D13,D14,D15,D16,D17,D18,D19,
     *         D20,D21,D22,D23,D24,D25,D26,D27,D28,D29,
     *         D30,D31,D32,D33,D34,D35,D36,D37,D38,D39,
     *         D40,D41,D42,D43,D44,D45,D46,D47,D48,D49,
     *         D50,D51,D52,D53,D54,D55,D56,D57,D58,D59,
     *         D60,D61,D62,D63,D64)
C
      DOUBLE PRECISION CHECK,RUNTYP,EXETYP
      DOUBLE PRECISION GROUP,Q(NOITMS),QNAME(1)
      DOUBLE PRECISION  D1(1), D2(1), D3(1), D4(1), D5(1)
      DOUBLE PRECISION  D6(1), D7(1), D8(1), D9(1),D10(1)
      DOUBLE PRECISION D11(1),D12(1),D13(1),D14(1),D15(1)
      DOUBLE PRECISION D16(1),D17(1),D18(1),D19(1),D20(1)
      DOUBLE PRECISION D21(1),D22(1),D23(1),D24(1),D25(1)
      DOUBLE PRECISION D26(1),D27(1),D28(1),D29(1),D30(1)
      DOUBLE PRECISION D31(1),D32(1),D33(1),D34(1),D35(1)
      DOUBLE PRECISION D36(1),D37(1),D38(1),D39(1),D40(1)
      DOUBLE PRECISION D41(1),D42(1),D43(1),D44(1),D45(1)
      DOUBLE PRECISION D46(1),D47(1),D48(1),D49(1),D50(1)
      DOUBLE PRECISION D51(1),D52(1),D53(1),D54(1),D55(1)
      DOUBLE PRECISION D56(1),D57(1),D58(1),D59(1),D60(1)
      DOUBLE PRECISION D61(1),D62(1),D63(1),D64(1)
      DOUBLE PRECISION DBLV
C
      CHARACTER*80 TEMP,CSTRNG
      CHARACTER*8 GRPNAM
C
      REAL C,CH8,NAME(8),EQUALS,BLANK,XMARKR
C
      INTEGER CMSG(80)
C
      LOGICAL LOG,FOUND,GOPARR,DSKWRK,MASWRK,TDSKWRK
C
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /QQQQZR/ DBLV,INTV,I,NX,NREL,INPLU,LOG,REALV,C(80),CH8(8)
      COMMON /QQQQCH/ CSTRNG
      COMMON /RUNOPT/ RUNTYP,EXETYP,NEVALS,NGLEVL,NHLEVL
C
      DIMENSION KQ(NOITMS)
C
      DATA CHECK   /8HCHECK   /
      DATA EQUALS/1H=/, XMARKR/1HX/, BLANK/1H /
C
C     THIS ROUTINE PROVIDES THE CAPABILITY FOR DOING NAMELIST INPUT
C
C     ----------------- HOW TO USE THIS ROUTINE -------------------
C            To add a new input to a NAMEIO-processed group,
C      
C      a) we must increment the value of NNAM by 1.  NNAM sets the
C         dimension of two arrays, and tells how many non-dummy
C         args are passed to NAMEIO.
C      b) we must select the keyword, by adding a new element to
C         QNAM's end.  For example, this might be /8HKEYWRD  /.
C         These may not exceed 6 letters (because originally
C         FORTRAN variables could not exceed 6), so inside NAMEIO
C         it only looks at 6 letters: the last two must be blanks.
C         String values scanned in may go up to 8 letters, but the
C         keyword itself must be 6 or less.  Finally, the 8H
C         initializations must use capital letters, as the code
C         here converts anything read in to capitals, before
C         matching against the QNAM values.
C      c) we must define the type, by adding a value to KQNAM, in
C         the matching position to QNAM (this order also applies
C         to the arguments of NAMEIO that follow the usual first
C         six arguments).  There is no rhyme or reason to the
C         types, they are just
C              0=logical        (e.g. DIRSCF)
C              1=integer        (e.g. MULT)
C              3=floating point (e.g. OPTTOL)
C              5=characters     (e.g. SCFTYP)
C         Note that to help users, -always- (which means absolutely
C         no exceptions) make the spelling of QNAM match the FORTRAN
C         convention for KQNAM=1 or 3.  Namely, integer keywords must
C         always start with I-N, and floating points with A-H,O-Z.
C      d) add a new argument to NAMEIO.  This is a FORTRAN variable,
C         and does not have to match the spelling chosen in QNAM,
C         but it is simpler if it does.  (less confusing to future
C         readers of the code).  One of the dummy 0's present must
C         be deleted to preserve the correct number of arguments
C         (64 total args, not counting the usual first 6).
C      e) give a default value to the FORTRAN variable before
C         calling NAMEIO, e.g. DIRSCF=.FALSE.
C      f) If the keyword is to read a vector, rather than a scalar,
C         the maximum number of elements that the scanner will
C         process is included in the KQNAM value.  For example,
C         a KQNAM of 83 will read up to 8 (KQNAM/10) data items
C         of type double precision (MOD(KQNAM,10)=3).
C
C     ----------------- THE ORIGINAL DOCUMENTATION -----------------
C
C     THE USER IS THEREFORE REQUIRED TO
C     PROVIDED VIA ROUTINE ARGUMENTS THE SORT OF INFORMATION
C     AUTOMATICALLY PROVIDED BY A COMPILER,
C     THAT IS, THE VARIABLE NAMES, DATA TYPES,
C     DIMENSIONS, ETC. THESE ARE ALL STATIC ATTRIBUTES OF THE
C     VARIABLES. IN ADDITION IT IS NECESSARY TO PROVIDE THE RUN
C     TIME LOCATIONS OF ALL VARIABLES. THIS IS DONE BE PROVIDING
C     AN ARGUMENT IN THE PROCEDURE FOR EACH ITEM IN THE NAMELIST
C     GROUP. THE NUMBER OF ARGUMENTS IN FORTRAN MUST BE FIXED.
C     THIS HAS BEEN SET AT 32 NAMELIST VARIABLES IN THE PRESENT
C     ROUTINE. THIS IS EASILY CHANGED UP TO A MAXIMUM OF 50
C     ARGUMENTS BY ADDING  ADDITIONAL CALLS TO QVRTZQ BELOW.
C
C     DESCRIPTION OF THE ARGUMENTS...
C
C       NFA     FILE FROM WHICH NAMELIST DATA WILL BE READ.
C       JRET =  ERROR CONDITION RETURN CODE
C            =0      NORMAL COMPLETION
C            =1      RETURN CODE IN CASE REQUESTED NAMELIST
C                    DATA CANNOT BE FOUND (I.E., WHEN EOF ON FILE
C                    NFA IS ENCOUNTERED).
C            =2      RETURN CODE IN CASE OF NAMELIST DATA
C                    SYNTAX ERROR, UNKNOWN VARIABLE NAME, ETC.
C       GROUP   NAMELIST GROUP NAME (IN H-FORMAT). GROUP MUST
C               BE TYPED DOUBLE PRECISION.
C       NOITMS  NUMBER OF ITEMS (NAMES) IN THE NAMELIST GROUP.
C       Q       A DOUBLE PRECISION ARRAY OF LENGTH NOITMS GIVING
C               THE NAMES (IN H-FORMAT) OF THE NAMELIST ITEMS.
C       KQ      AN INTEGER ARRAY CONTAINING TYPE AND (LINEAR)
C               DIMENSION INFORMATION FOR EACH ITEM IN VECTOR Q.
C               EACH ITEM IN KQ HAS THE FORM
C                   (ARRAY SIZE)*10 + (DATA TYPE CODE)
C               WHERE CURRENTLY ONLY THE FOLLOWING DATA TYPE CODES
C               ARE SUPPORTED...
C                   0 - LOGICAL
C                   1 - INTEGER
C                   2 - REAL (SINGLE PRECISION)
C                   3 - DOUBLE PRECISION
C                   4 - 4 LETTER CHARACTER STRING (I.E. SINGLE PRECISN)
C                   5 - 8 LETTER CHARACTER STRING (I.E. DOUBLE PRECISN)
C                   9 - SCANNING MODE (SEE BELOW)
C               (ARRAY SIZE) IS THE NUMBER OF WORDS RESERVED FOR
C               THE ARRAY CONSIDERING ALL ARRAYS AS EFFECTIVELY
C               ONE DIMENSIONAL. IF THE ARRAY SIZE GIVEN IS  0
C               ONE CAN STILL INPUT DATA AS CONSTANT LISTS BUT NO
C               DIMENSION CHECKING WILL BE PERFORMED. CONVERSELY,
C               IF SUBSCRIPTS ARE OMITTED, THE VARIABLE WILL BE
C               TREATED AS IF IT WERE NON-SUBSCRIPTED AND THE
C               ASSOCIATED CONSTANT LIST MUST BE OF LENGTH ONE.
C               FOR EXAMPLE, THE NAMELIST DATA STATEMENT
C                    $INPUT R=2.0, R(5)=1,2,3,4 $END
C               IS LEGAL BUT
C                    $INPUT R=1,2,3, R(5)=4 $END
C               IS NOT (WHERE THE ARRAY SIZE IS EITHER  0  OR LARGE
C               ENOUGH TO ACCOMMODATE THE LONGEST CONSTANT LIST).
C               THE PHILOSOPHY USED IS THAT THE USER CAN PROTECT
C               HIMSELF FROM INADVERTANT MODIFICATIONS BUT IF HE
C               CHOOSES NOT TO THAT IS ALRIGHT TOO.
C               IF SCANNING MODE IS SPECIFIED, THEN KQ HAS THE FOLLOWING
C               FORMAT:
C                   (DATA TYPE CODE)*10 + 9
C               THE PURPOSE OF THE SCANNING MODE IS TO READ ARRAYS
C               TO A SINGLE VARIABLE SPACE LIKE THIS
C                   READ (*,*) (A(1),K=1,N)
C               THIS IS USEFUL WHEN ARRAY DIMENSION IS NOT KNOWN AHEAD
C               OF TIME, SO IN THE FIRST CALL TO NAMEIO THAT DIMENSION
C               IS READ AS A REGULAR KEYWORD AND THE ARRAY ITSELF IS
C               "SCANNED".  IN THE SECOND CALL THE ARRAY IS STORED
C               REGULARLY.
C
C       D1-D32  NAMELIST VARIABLES IN THE SAME ORDER AS SPECIFIED
C               IN THE VECTOR Q.
C
C     NAMES MUST BE LEGAL FORTRAN VARIABLE NAMES. NULL VALUES ARE
C     NOT ALLOWED IN CONSTANT LISTS (THAT IS, THE ASSIGNMENT
C     A(1)=2,,3,4, WILL NOT BE INTERPRETED AS A(1)=2,0,3,4 BUT
C     ACTUALLY AS A(1)=2,3,4, ). MORE SPECIFICALLY, ANY STRING
C     OF BLANKS AND COMMAS COUNTS AS A SINGLE DELIMITER.
C     BLANKS ARE SIGNIFICANT WHEN NOT PROCEEDING OR FOLLOWING
C     A COMMA.
C
C     USAGE EXAMPLE...
C       IMPLICIT DOUBLE PRECISION (A-H,O-Z), INTEGER(I-N)
C       . . .
C       DIMENSION X(10),Y(29)
C       DIMENSION Q(5),KQ(5)
C       DATA Q/1HX,1HY,4HNSYM,1HR,3HMAX/
C       DATA KQ/103,293,1,3,1/
C       DATA GROUP/4HDATA/
C       ... ...
C       CALL NAMEIO(5,JRET,GROUP,5,Q,KQ,X,Y,NSYM,R,MAX,)
C       IF(JRET.EQ.1) GO TO 10
C       IF(JRET.EQ.2) GO TO 30
C       ...
C  C         COME HERE ON END-OF-FILE ON 5.
C    10 CONTINUE
C       ...
C  C         COME HERE ON DATA FORMAT ERRORS
C    30 CONTINUE
C       ...
C
C    FOR WHICH ONE MIGHT HAVE THE DATA STATEMENT
C
C       $DATA R=3.015,X(1)=3,4,5, Y(6)=0,0,0, Y(1)=10.0,NSYM=2 $END
C
C     ERROR HANDLING
C
C     FAILURE TO FIND THE REQUESTED NAMELIST DATA STATEMENT WILL
C     RESULT IN JRET BEING SET TO 1.
C     ERRORS IN THE DATA FORMATS, UNKNOWN NAMES, ETC. WILL RESULT
C     IN THE ROUTINE RETURNING JRET SET TO 2.
C
C     NOTE -- ALL ROUTINE AND COMMON BLOCK NAMES REFERENCED BY
C             NAMEIO CONTAIN Q AND Z TO DISTINGUISH THEM
C             FROM NORMAL FORTRAN PROCEDURE NAMES. SPECIFICALLY,
C             REFERENCES ARE MADE TO THE FOLLOWING...
C
C             COMMON QQQQZR, QTZNAM, QTZSUB, QTZVAL, QTZLOG,
C             QVRTZQ, QNZCRD, QVRTZD, QVRTZI, QVRTZL, QVRTZR
C
C     FUTURE ENHANCEMENTS...
C
C     IF INTEREST WARRENTS, WITHOUT MUCH DIFFICULTY ONE CAN ADD
C     CHARACTER CONSTANTS, HEXADECIMAL
C     CONSTANTS, AND THE LIST SHORTHAND CONSTRUCTION  N*VALUE.
C
      TDSKWRK = DSKWRK
      DSKWRK = .FALSE.
      FOUND = .FALSE.
      JRET = 0
      IZERO = 0
      IONE = 1
C
C     ----- POSITION INPUT FILE TO BEGINNING -----
C
      INPLU = NFA
      CALL SEQREW(INPLU)
C
C     ----- DETERMINE GROUP NAME TO BE SOUGHT -----
C
  090 CONTINUE
      WRITE(UNIT=GRPNAM,FMT='(A8)')  GROUP
      READ (UNIT=GRPNAM,FMT='(8A1)') (NAME(I),I=1,8)
      I = 8
      DO 100 J = 1,7
         I = I-1
         IF (GRPNAM(I:I) .NE. ' ') GO TO 140
  100 CONTINUE
C
C        THE GROUP NAME IS BLANK, ERROR
C
      IF (MASWRK) WRITE (6,9008)
      JRET = 2
      DSKWRK = TDSKWRK
      RETURN
C
  140 CONTINUE
      LENNAM = I + 1
      IF(GRPNAM(LENNAM:LENNAM) .EQ. ' ') GO TO 150
C
C        GROUP NAME DOES NOT END WITH A BLANK, ERROR
C
         IF (MASWRK) WRITE(6,9009) GROUP
         JRET = 2
         DSKWRK = TDSKWRK
         RETURN
C
C     ----- BEGIN SEARCH FOR THIS GROUP IN INPUT FILE -----
C        LOOK FOR A BLANK IN COLUMN 1 AND A $ IN COLUMN 2
C
  150 CONTINUE
      IF (MASWRK) THEN
  160    CONTINUE
         READ (INPLU,9068,END = 1400) CSTRNG
         IF (CSTRNG(1:1) .NE. ' ' ) GO TO 160
         IF (CSTRNG(2:2) .NE. '$') GO TO 160
         CALL UPRCAS(CSTRNG,80)
C
C        FOUND $, IS NAME RIGHT
C
         IF (CSTRNG(3:LENNAM+2) .NE. GRPNAM(1:LENNAM)) GO TO 160
C
C     ----- CORRECT INPUT GROUP FOUND ----
C
         READ (UNIT=CSTRNG,FMT='(80A1)') C
         IF (GOPARR) THEN
            CALL DDI_BCAST(250,'I',IZERO,1,MASTER)
            DO 200 I=1,80
               CMSG(I) = ICHAR(CSTRNG(I:I))
  200       CONTINUE
         END IF
      ELSE
         IF (GOPARR) CALL DDI_BCAST(250,'I',IFND,1,MASTER)
         IF (IFND.EQ.IONE) GO TO 1400
      END IF
      IF (GOPARR) CALL DDI_BCAST(251,'I',CMSG,80,MASTER)
      IF (.NOT.MASWRK) THEN
         DO 220 I=1,80
            CSTRNG(I:I) = CHAR(CMSG(I))
  220    CONTINUE
         READ (UNIT=CSTRNG,FMT='(80A1)') C
      END IF
      FOUND = .TRUE.
      I = LENNAM + 2
C
C        GET THE NEXT VARIABLE NAME
C
  240 CONTINUE
      IRET = 0
      CALL QTZNAM(NAME,I,IRET)
      IF (IRET .EQ. 1) GO TO 1500
      IF (IRET .EQ. 2) GO TO 1410
      IF (CSTRNG(I:I) .EQ. '$') GO TO 1300
C
C        MATCH VARIABLE NAME WITH ITEMS IN LIST
C
      WRITE(UNIT=TEMP,FMT='(8A1)') (NAME(J),J=1,8)
      READ (UNIT=TEMP,FMT='(A8)')  QNAME
      DO 300 J = 1,NOITMS
         IF (Q(J) .EQ. QNAME(1)) GO TO 360
  300 CONTINUE
      GO TO 1500
C
C        VARIABLE NAME MATCHES ITEM  IT  IN LIST
C
  360 CONTINUE
      IT = J
      NRELMX = KQ(J)/10
      NX = KQ(J)-NRELMX*10
      ISCAN=0
      IF(NX.EQ.9) THEN
        NXTMP=NRELMX/10
        NX=NRELMX-NXTMP*10
        ISCAN=1
      END IF
      NREL = 0
C
C        CHECK FOR SUBSCRIPT
C
      IF (CSTRNG(I:I) .EQ. '=') GO TO 440
      IF (CSTRNG(I:I) .EQ. '(') GO TO 400
C        ..... SOMETHING WRONG HERE
  380    IF (MASWRK) WRITE (6,9108) GROUP
         GO TO 1500
C
C      .....SCAN OFF SUBSCRIPT
C
  400 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 1410
      NSUB = 0
      CALL QTZSUB(NSUB,I,IRET)
      IF (IRET .EQ. 1) GO TO 1500
      IF (IRET .EQ. 2) GO TO 1410
  420 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 1410
      IF (C(I) .EQ. BLANK) GO TO 420
      IF (C(I) .NE. EQUALS) GO TO 380
      IF (ISCAN.EQ.1) NSUB=1
      NREL = NSUB
C
C        READY TO FIND VALUE(S)
C
  440 CONTINUE
      NV = 0
  480 CONTINUE
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 1410
      MOD = 0
      CALL QTZVAL(MOD,I,IRET)
      IF (IRET .EQ. 1) GO TO 1500
      IF (IRET .EQ. 2) GO TO 1410
      IF (MOD .EQ. -2) GO TO 240
      IF (MOD .EQ. -1) GO TO 1350
C
C      .....VALID NUMBER...
C       MOD=0 FOR LOGICAL
C       MOD=1 FOR INTEGER
C       MOD=2 FOR REAL,
C       MOD=3 FOR DOUBLE PRECISION
C      .....INVALID NUMBER...
C       MOD=-1 $END FOUND
C       MOD=-2 FOR ANOTHER VARIABLE NAME,
C
      IF (NX .EQ. 0) GO TO 560
      IF (NX .EQ. 1) GO TO 500
      IF (NX .EQ. 2) GO TO 520
      IF (NX .EQ. 3) GO TO 540
      IF (NX .EQ. 4) GO TO 560
      IF (NX .EQ. 5) GO TO 560
      IF (MASWRK) WRITE (6,9128) NX
      GO TO 1500
C
C      .....TARGET VARIABLE IS AN INTEGER
C
  500 IF (MOD .EQ. 1) GO TO 560
      IF (MOD .EQ. 2) INTV = INT(REALV)
      IF (MOD .EQ. 3) INTV = INT(DBLV)
      GO TO 560
C
C      .....TARGET VARIABLE IS REALV
C
  520 IF (MOD .EQ. 1) REALV = INTV
      IF (MOD .EQ. 2) GO TO 560
      IF (MOD .EQ. 3) REALV = DBLV
      GO TO 560
C
C      .....TARGET VARIABLE IS DOUBLE
C
  540 IF (MOD .EQ. 1) DBLV = INTV
      IF (MOD .EQ. 2) DBLV = REALV
C
  560 IF (NREL .EQ. 0) GO TO 580
C
C      .....ARRAY VARIABLE
C
      NDEL = 1
      IF(NREL.LE.NRELMX  .OR.  ISCAN.NE.0 ) GO TO 600
      IF(NRELMX.EQ.0) NRELMX=1
      IF(MASWRK) WRITE (6,9148) QNAME,NRELMX
      GO TO 1500
C
C      .....NON-SUBSCRIPTED VARIABLE
C
  580 NDEL = 0
      IF (NV.EQ.0) GO TO 600
      IF (MASWRK) WRITE (6,9168)
      GO TO 1500
C
C     ...... STORE THE VALUE FOR THE APPROPRIATE ITEM
C
  600 CONTINUE
      GO TO (    601,602,603,604,605,606,607,608,609,
     *       610,611,612,613,614,615,616,617,618,619,
     *       620,621,622,623,624,625,626,627,628,629,
     *       630,631,632,633,634,635,636,637,638,639,
     *       640,641,642,643,644,645,646,647,648,649,
     *       650,651,652,653,654,655,656,657,658,659,
     *       660,661,662,663,664), IT
  601 CALL QVRTZQ(D1)
                       GO TO 1260
  602 CALL QVRTZQ(D2)
                       GO TO 1260
  603 CALL QVRTZQ(D3)
                       GO TO 1260
  604 CALL QVRTZQ(D4)
                       GO TO 1260
  605 CALL QVRTZQ(D5)
                       GO TO 1260
  606 CALL QVRTZQ(D6)
                       GO TO 1260
  607 CALL QVRTZQ(D7)
                       GO TO 1260
  608 CALL QVRTZQ(D8)
                       GO TO 1260
  609 CALL QVRTZQ(D9)
                       GO TO 1260
  610 CALL QVRTZQ(D10)
                       GO TO 1260
  611 CALL QVRTZQ(D11)
                       GO TO 1260
  612 CALL QVRTZQ(D12)
                       GO TO 1260
  613 CALL QVRTZQ(D13)
                       GO TO 1260
  614 CALL QVRTZQ(D14)
                       GO TO 1260
  615 CALL QVRTZQ(D15)
                       GO TO 1260
  616 CALL QVRTZQ(D16)
                       GO TO 1260
  617 CALL QVRTZQ(D17)
                       GO TO 1260
  618 CALL QVRTZQ(D18)
                       GO TO 1260
  619 CALL QVRTZQ(D19)
                       GO TO 1260
  620 CALL QVRTZQ(D20)
                       GO TO 1260
  621 CALL QVRTZQ(D21)
                       GO TO 1260
  622 CALL QVRTZQ(D22)
                       GO TO 1260
  623 CALL QVRTZQ(D23)
                       GO TO 1260
  624 CALL QVRTZQ(D24)
                       GO TO 1260
  625 CALL QVRTZQ(D25)
                       GO TO 1260
  626 CALL QVRTZQ(D26)
                       GO TO 1260
  627 CALL QVRTZQ(D27)
                       GO TO 1260
  628 CALL QVRTZQ(D28)
                       GO TO 1260
  629 CALL QVRTZQ(D29)
                       GO TO 1260
  630 CALL QVRTZQ(D30)
                       GO TO 1260
  631 CALL QVRTZQ(D31)
                       GO TO 1260
  632 CALL QVRTZQ(D32)
                       GO TO 1260
  633 CALL QVRTZQ(D33)
                       GO TO 1260
  634 CALL QVRTZQ(D34)
                       GO TO 1260
  635 CALL QVRTZQ(D35)
                       GO TO 1260
  636 CALL QVRTZQ(D36)
                       GO TO 1260
  637 CALL QVRTZQ(D37)
                       GO TO 1260
  638 CALL QVRTZQ(D38)
                       GO TO 1260
  639 CALL QVRTZQ(D39)
                       GO TO 1260
  640 CALL QVRTZQ(D40)
                       GO TO 1260
  641 CALL QVRTZQ(D41)
                       GO TO 1260
  642 CALL QVRTZQ(D42)
                       GO TO 1260
  643 CALL QVRTZQ(D43)
                       GO TO 1260
  644 CALL QVRTZQ(D44)
                       GO TO 1260
  645 CALL QVRTZQ(D45)
                       GO TO 1260
  646 CALL QVRTZQ(D46)
                       GO TO 1260
  647 CALL QVRTZQ(D47)
                       GO TO 1260
  648 CALL QVRTZQ(D48)
                       GO TO 1260
  649 CALL QVRTZQ(D49)
                       GO TO 1260
  650 CALL QVRTZQ(D50)
                       GO TO 1260
  651 CALL QVRTZQ(D51)
                       GO TO 1260
  652 CALL QVRTZQ(D52)
                       GO TO 1260
  653 CALL QVRTZQ(D53)
                       GO TO 1260
  654 CALL QVRTZQ(D54)
                       GO TO 1260
  655 CALL QVRTZQ(D55)
                       GO TO 1260
  656 CALL QVRTZQ(D56)
                       GO TO 1260
  657 CALL QVRTZQ(D57)
                       GO TO 1260
  658 CALL QVRTZQ(D58)
                       GO TO 1260
  659 CALL QVRTZQ(D59)
                       GO TO 1260
  660 CALL QVRTZQ(D60)
                       GO TO 1260
  661 CALL QVRTZQ(D61)
                       GO TO 1260
  662 CALL QVRTZQ(D62)
                       GO TO 1260
  663 CALL QVRTZQ(D63)
                       GO TO 1260
  664 CALL QVRTZQ(D64)
C
 1260 CONTINUE
      NV = NV+1
      IF(ISCAN.EQ.0) NREL = NREL+NDEL
C
C        LOGICAL AND CHARACTER SHOULD NOT KEEP PARSING AFTER FINDING
C        ALL VALUES, SINCE THEY LOOK FOR LETTERS (AND THE LETTERS MIGHT
C        BE THE NEXT KEYWORD!).  IF AN ADDITIONAL ITEM LIKE A .TRUE. OR
C        A RANDOM CHARACTER VALUE IS FOUND, WE'LL GET A MESSAGE ABOUT
C        AN ILLEGAL KEYWORD ENCOUNTERED.  THIS MAY BE HARD FOR USERS TO
C        UNDERSTAND, UNLESS THEY REALIZE THE PREVIOUS ARRAY FILLED UP.
C        NOTE THAT CHARACTER AND LOGICAL ARRAYS ARE RARE, ANYWAY.
C
      IF(ISCAN.NE.0) GO TO 480
      IF(NX.EQ.0  .AND.  NV.GE.NRELMX) GO TO 240
      IF(NX.EQ.4  .AND.  NV.GE.NRELMX) GO TO 240
      IF(NX.EQ.5  .AND.  NV.GE.NRELMX) GO TO 240
      GO TO 480
C
 1300 CONTINUE
      IF (NAME(1) .NE. BLANK) GO TO 1500
C
C        CHECK FOR END OF GROUP
C
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 1410
      IF (CSTRNG(I:I+2) .NE. 'END') GO TO 1500
 1350 CONTINUE
      GO TO 090
C     RETURN  ! IF FIRST GROUP MATCH IS SUFFICIENT
C
C        ..... END OF INPUT FILE DETECTED
C
 1400 CONTINUE
      IF (MASWRK.AND.GOPARR) CALL DDI_BCAST(250,'I',IONE,1,MASTER)
      IF (FOUND) THEN
         IF ((EXETYP .EQ. CHECK) .AND. MASWRK) WRITE(6,9000) GROUP
         DSKWRK = TDSKWRK
         RETURN
      END IF
 1410 JRET = 1
      IF ((EXETYP .EQ. CHECK) .AND. MASWRK) WRITE(6,9001) GROUP
      DSKWRK = TDSKWRK
      RETURN
C
C        ..... ILLEGAL VARIABLE NAME IN INPUT
C
 1500 CONTINUE
      IF (MASWRK) THEN
         WRITE(6,9058) GROUP,CSTRNG,(BLANK,J=1,I),XMARKR
         WRITE(6,9188) Q
      END IF
      JRET = 2
      DSKWRK = TDSKWRK
      RETURN
C
 9000 FORMAT(' CHECK SHOWS $',A8,' GROUP SYNTAX IS OK')
 9001 FORMAT(' CHECK SHOWS $',A8,' GROUP INPUT IS NOT PRESENT')
 9008 FORMAT(1X,'BLANK GROUP NAME')
 9009 FORMAT(1X,'*** ERROR:  GROUP NAME >',A8,'< HAS NO TRAILING BLANK')
 9058 FORMAT(1X,'**** ERROR READING INPUT GROUP $',A8,' *****'/
     * 1X,'THE PROBLEM IS WITH THIS INPUT LINE, NEAR THE X MARKER'/
     *       A80/80A1)
 9068 FORMAT(A80)
 9108 FORMAT(1X,'INPUT SCANNER WAS EXPECTING = OR ( BUT FOUND',A8)
 9128 FORMAT(/1X,'INVALID DATA TYPE ',I8)
 9148 FORMAT(/1X,'OUT OF BOUNDS REFERENCE FOR INPUT ARRAY KEYWORD ',A8/
     *        1X,'ONLY',I8,' DATA ITEMS MAY BE GIVEN FOR THIS KEYWORD.')
 9168 FORMAT(/1X,'CONSTANT LIST TOO LONG')
 9188 FORMAT(1X,'THE ONLY KEYWORDS ACCEPTED IN THIS GROUP ARE:'/
     *          (6(2X,A8)))
      END
C*MODULE NAMEIO  *DECK QNZCRD
      SUBROUTINE QNZCRD(IRET)
C
C     ----- INCREMENT COLUMN POINTER, GET NEW CARD IF NECESSARY
C
      IMPLICIT INTEGER   (A-Z)
C
      DOUBLE PRECISION DBL
      REAL C,CH8,REAL
      INTEGER CMSG(80)
      LOGICAL LOG,COMENT,GOPARR,DSKWRK,MASWRK
      CHARACTER*1 TSTCHR,COMCHR
      CHARACTER*80 CSTRNG
C
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
      COMMON /QQQQCH/ CSTRNG
C
      PARAMETER (COMCHR='!')
C
      IRET = 0
      IZERO = 0
      IONE = 1
      COMENT = .FALSE.
  100 CONTINUE
         I = I+1
         IF (I .LT. 81) GO TO 110
C
C              GET ANOTHER CARD
C
            IF (MASWRK) THEN
               READ (INPLU,9008,END = 120) CSTRNG
               CALL UPRCAS(CSTRNG,80)
               READ (UNIT=CSTRNG,FMT='(80A1)') C
               IF (GOPARR) THEN
                  CALL DDI_BCAST(260,'I',IZERO,1,MASTER)
                  DO 102 I=1,80
                     CMSG(I) = ICHAR(CSTRNG(I:I))
  102             CONTINUE
               END IF
            ELSE
               IF (GOPARR) CALL DDI_BCAST(260,'I',JEND,1,MASTER)
               IF (JEND.EQ.IONE) GO TO 120
            END IF
            IF (GOPARR) CALL DDI_BCAST(261,'I',CMSG,80,MASTER)
            IF(.NOT.MASWRK) THEN
               DO 104 I=1,80
                  CSTRNG(I:I) = CHAR(CMSG(I))
  104          CONTINUE
               READ (UNIT=CSTRNG,FMT='(80A1)') C
            END IF
            I = 1
            COMENT = .FALSE.
  110    CONTINUE
         WRITE(UNIT=TSTCHR,FMT='(A1)') C(I)
         IF(TSTCHR .EQ. COMCHR) COMENT = .NOT.COMENT
      IF(COMENT) GO TO 100
      IF(TSTCHR .EQ. COMCHR) I = I + 1
      RETURN
C
C     ..... END OF INPUT FILE DETECTED
C
  120 IF (MASWRK) THEN
         IF (GOPARR) CALL DDI_BCAST(260,'I',IONE,1,MASTER)
         WRITE (6,9028) INPLU
      END IF
      IRET = 1
      RETURN
C
 9008 FORMAT(A80)
 9028 FORMAT(/1X,'EOF ENCOUNTERED ON FILE', I4 )
      END
C*MODULE NAMEIO  *DECK QTZLOG
      SUBROUTINE QTZLOG(IDLIM,IRET)
C.....
C.....THIS ROUTINE SCANS OFF LOGICAL VALUES .T., .TRUE.,
C......F., AND .FALSE. ASSUMING THE SCANNER ALREADY STANDS
C.....AT THE INITIAL T OR F ON ENTERING. IDLIM WILL BE LEFT
C.....POINTING AT THE DELIMITING TRAILING BLANK OR COMMA
C.....(ANYTHING ELSE IS ILLEGAL).
C.....
      DOUBLE PRECISION DBL
      REAL C,CH8,TRUE(5),FALSE(6),PERIOD,BLANK,COMMA
      LOGICAL LOG
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      DATA PERIOD/1H./,BLANK/1H /,COMMA/1H,/
      DATA TRUE/1HT,1HR,1HU,1HE,1H./
      DATA FALSE/1HF,1HA,1HL,1HS,1HE,1H./
C
      IRET = 0
      LOG = .FALSE.
      IF (C(I) .EQ. TRUE(1)) GO TO 240
C
C         .....SCAN OFF .F. OR .FALSE.
C
         CALL QNZCRD(IRET)
         IF (IRET .EQ. 1) GO TO 300
         IF (C(I) .NE. PERIOD) GO TO 200
  120    CALL QNZCRD(IRET)
         IF (IRET .EQ. 1) GO TO 300
  140    IF (C(I) .EQ. BLANK .OR. C(I) .EQ. COMMA) GO TO 180
  160    CONTINUE
         IRET = 1
         RETURN
C
C           LOGICAL VALUE OK
C
  180    IDLIM = I
         RETURN
C
  200    DO 220 J = 2,6
            IF (C(I) .NE. FALSE(J)) GO TO 160
            CALL QNZCRD(IRET)
            IF (IRET .EQ. 1) GO TO 300
  220    CONTINUE
         GO TO 140
C
C         .....   SCAN OFF .T. OR .TRUE.
C
  240 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 300
      IF (C(I) .NE. PERIOD) GO TO 260
      LOG = .TRUE.
      GO TO 120
C
  260 DO 280 J = 2,5
      IF (C(I) .NE. TRUE(J)) GO TO 160
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 300
  280 CONTINUE
      LOG = .TRUE.
      GO TO 140
C
C      .....END OF FILE ON INPUT
C
  300 IRET = 2
      RETURN
      END
C*MODULE NAMEIO  *DECK QTZNAM
      SUBROUTINE QTZNAM(NAME,IDLIM,IRET)
C
C     ----- GET VARIABLE NAME -----
C
      IMPLICIT INTEGER  (A-Z)
C
      REAL   REAL
      REAL NAME(8),C,VC(36),CH8
      REAL BLANK,COMMA,DOLLAR,LPAREN,EQUALS
      LOGICAL LOG,GOPARR,DSKWRK,MASWRK
      DOUBLE PRECISION DBL
C
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      DATA BLANK/1H /,COMMA/1H,/,DOLLAR/1H$/,LPAREN/1H(/,EQUALS/1H=/
      DATA VC/1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,
     +        1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX,
     +        1HY,1HZ,1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
C
C        CLEAR VARIABLE NAME
C
      IRET = 0
      DO 100 J = 1,8
  100 NAME(J) = BLANK
      GO TO 140
C
  120 CONTINUE
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 280
  140 CONTINUE
      IF (C(I) .EQ. BLANK) GO TO 120
      IF (C(I) .EQ. COMMA) GO TO 120
      IF (C(I) .EQ. DOLLAR) GO TO 300
      DO 160 J = 1,26
         IF (C(I) .EQ. VC(J)) GO TO 180
  160 CONTINUE
C
C        NAME DOES NOT BEGIN WITH AN ALPHA CHARACTER
C
      NAME(1) = C(I)
      GO TO 250
C
  180 NAME(1) = C(I)
      DO 220 M = 2,7
         CALL QNZCRD(IRET)
         IF (IRET .EQ. 1) GO TO 280
C
C         .....IS C(I) A LETTER OR NUMERAL...
C
         DO 200 J = 1,36
            IF (C(I) .EQ. VC(J)) GO TO 220
  200    CONTINUE
C
C         .....NO, MAYBE ITS A BLANK, LEFT PAREN, OR EQUALS
C
         IF (C(I) .EQ. EQUALS .OR. C(I) .EQ. LPAREN) GO TO 300
         IF (C(I) .EQ. BLANK) GO TO 320
C
C           .....MUST BE A MISTAKE
C
         GO TO 240
C
  220 NAME(M) = C(I)
C
C        .....SOMETHING WRONG WITH VARIABLE NAME
C
  240 IF (MASWRK) WRITE (6,9008) NAME
      IRET = 1
      RETURN
  250 IF(MASWRK) WRITE(6,9009) NAME(1)
      IRET = 1
      RETURN
  260 CONTINUE
      IRET = 1
      RETURN
C
C      ....EOF ON INPUT
C
  280 IRET = 2
      RETURN
C
C      .....VARIABLE NAME IS OK
C
  300 IDLIM = I
      RETURN
C
C      .....BLANK TERMINATES NAME. FIND REAL DELIMITER...
C
  320 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 300
      IF (C(I) .EQ. BLANK) GO TO 320
      IF (C(I) .EQ. EQUALS .OR. C(I) .EQ. LPAREN) GO TO 300
      IF (MASWRK) WRITE (6,9028)
      GO TO 260
C
 9008 FORMAT(1X,'INVALID NAME >',8A1,'< ENCOUNTERED IN NAMELIST')
 9009 FORMAT(1X,'FIRST CHARACTER OF ANY KEYWORD >',A1,
     *          '< MUST ALWAYS BE A LETTER')
 9028 FORMAT(1X,'INPUT SCANNER WAS EXPECTING = OR ( VALUE.')
      END
C*MODULE NAMEIO  *DECK QTZSUB
      SUBROUTINE QTZSUB(INTSUB,IDLIM,IRET)
C.....
C.....THIS ROUTINE SCANS OFF UNSIGNED INTEGER SUBSCRIPTS ONLY. THE
C.....ULTIMATE (NON-BLANK) DELIMITER MUST BE A RIGHT PAREN. SIGNS
C.....ON THE INTEGER CONSTANT ARE NOT ALLOWED.
C.....
      IMPLICIT INTEGER (A-Z)
C
      REAL REAL,C,CH8,DIG(10),BLANK,RPAREN
      LOGICAL   LOG,GOPARR,DSKWRK,MASWRK
      DOUBLE PRECISION DBL
C
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      DATA DIG/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9/
      DATA BLANK/1H /, RPAREN/1H)/
C
      IRET = 0
      INTSUB = 0
      GO TO 120
C
  100 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 260
  120 IF (C(I) .EQ. BLANK) GO TO 100
C
C      .....IS NON-BLANK CHARACTER 0,1,2,...,9
C
  140 DO 160 J = 1,10
         IF (C(I) .EQ. DIG(J)) GO TO 200
  160 CONTINUE
      IF (C(I) .EQ. BLANK) GO TO 220
      IF (C(I) .EQ. RPAREN) GO TO 240
  180 IF (MASWRK) WRITE (6,9008)
      IRET = 1
      RETURN
C
  200 INTSUB = INTSUB*10+(J-1)
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 260
      GO TO 140
C
C      .....TERMINATING BLANK FOUND...LOOK FOR RIGHT PAREN
C
  220 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 260
      IF (C(I) .EQ. BLANK) GO TO 220
      IF (C(I) .EQ. RPAREN) GO TO 240
      GO TO 180
C
C      .....FINALLY, INTSUB CANNOT BE ZERO OR THERE BE A NULL SUBSCRIPT
C
  240 IF (INTSUB .EQ. 0) GO TO 180
      IDLIM = I
      RETURN
C
  260 IRET = 2
      RETURN
C
 9008 FORMAT(1X,'ARRAY SUBSCRIPT INPUT SCANNER EXPECTS UNSIGNED',
     *          ' POSITIVE INTEGER')
      END
C*MODULE NAMEIO  *DECK QTZVAL
      SUBROUTINE QTZVAL(MOD,IDLIM,IRET)
C
C      ------ GET VALUE OF VARIABLE -----
C
      DOUBLE PRECISION DBLV,S,TEN,ZERO
      LOGICAL   LOG,GOPARR,DSKWRK,MASWRK
      REAL C,CH8,DIG(39)
      REAL END(3)
      REAL DEE,EEE
      REAL BLANK,COMMA,DOLLAR,PERIOD,PLUS,MINUS,EQUALS
      REAL TEE,EFF
      REAL LPAREN,RPAREN
C
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /QQQQZR/ DBLV,INTV,I,NX,NREL,INPLU,LOG,REALV,C(80),CH8(8)
C
      PARAMETER (ZERO = 0.0D+00, TEN = 10.0D+00)
C
      DATA DEE/1HD/,EEE/1HE/
      DATA TEE/1HT/,EFF/1HF/
      DATA DIG/1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9,
     +         1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI,1HJ,1HK,1HL,
     +         1HM,1HN,1HO,1HP,1HQ,1HR,1HS,1HT,1HU,1HV,1HW,1HX,
     +         1HY,1HZ,1H+,1H-,1H//
      DATA BLANK/1H /,COMMA/1H,/,DOLLAR/1H$/,PERIOD/1H./
      DATA PLUS/1H+/,MINUS/1H-/
      DATA END/1HE,1HN,1HD/
      DATA EQUALS/1H=/
      DATA LPAREN,RPAREN/1H(,1H)/
C
      IRET = 0
      DBLV = ZERO
      S = ZERO
      J = 0
      NPER = 0
      NDP = 0
      NDIG = 0
      ISIGN = 0
C
C       LOGICAL AND CHARACTER TYPES SHOULD NOT ENTER NUMBER SCAN CODE
C
      IF(NX.EQ.0) GO TO 560
      IF(NX.EQ.4  .OR.  NX.EQ.5) GO TO 820
      GO TO 120
C
C      .....SCAN OFF LEADING BLANKS AND COMMAS
C
  100 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 780
  120 IF (C(I) .EQ. BLANK) GO TO 100
      IF (C(I) .EQ. COMMA) GO TO 100
      IF (C(I) .EQ. DOLLAR) GO TO 400
C
C      .....IS THERE A SIGN
C
      IF (C(I) .EQ. PLUS) GO TO 220
      IF (C(I) .NE. MINUS) GO TO 180
      ISIGN = -1
      GO TO 240
C
  160 DBLV = J-1
      NDIG = 1
      GO TO 240
C
  180 IF (C(I) .EQ. PERIOD) GO TO 340
      DO 200 J = 1,10
         IF (C(I) .EQ. DIG(J)) GO TO 160
  200 CONTINUE
      MOD = -2
      GO TO 360
C
  220 ISIGN = 1
  240 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 780
  260 IF (C(I) .EQ. DEE .OR. C(I) .EQ. EEE) GO TO 620
C
C      .....LOOK UP DIGIT
C
      DO 300 J = 1,10
         IF (C(I) .EQ. DIG(J)) GO TO 520
  300 CONTINUE
      IF (C(I) .EQ. PERIOD) GO TO 540
      IF (C(I) .EQ. COMMA) GO TO 440
      IF (C(I) .EQ. BLANK) GO TO 440
      GO TO 380
C
  340 IF (NPER .NE. 0) GO TO 380
      NPER = 1
C
C      .....SCAN OFF POSSIBLE LOGICAL VALUES
C
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 780
      IF (C(I) .EQ. TEE .OR. C(I) .EQ. EFF) GO TO 560
      GO TO 260
C
  360 IDLIM = I
      RETURN
C
  380 IF (MASWRK) WRITE (6,9048)
  390 CONTINUE
      IRET = 1
      RETURN
C
C
C      .....SCAN OFF END
C
  400 DO 420 J = 1,3
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 780
      IF (C(I) .NE. END(J)) GO TO 380
  420 CONTINUE
      MOD = -1
      GO TO 360
C
  440 IF (NDP .EQ. 0) GO TO 480
C
C      .....ADJUST FOR DECIMAL POINT
C
      DBLV = DBLV*TEN**(-NDP)
      NDP = 0
  480 IF (NDIG .EQ. 0) GO TO 380
  500 IF (ISIGN .LT. 0) DBLV = -DBLV
      IF (NX .EQ. 0) GO TO 580
      IF (NX .EQ. 1) INTV = INT(DBLV)
      IF (NX .EQ. 2) REALV = DBLV
      MOD = NX
      GO TO 360
C
  520 S = J-1
      NDIG = NDIG+1
      DBLV = DBLV*TEN+S
      NDP = NDP+NPER
      GO TO 240
C
  540 IF (NPER .NE. 0) GO TO 380
      NPER = 1
      GO TO 240
C
C      .....SCAN OFF .T. OR .TRUE. OR .F. OR .FALSE.
C     CHECK FOR LEADING PERIOD, THEN ADVANCE TO THE NEXT CHARACTER.
C     NOTE: WE CAN ALSO BRANCH HERE IF A LOGICAL WAS FOUND AS INPUT
C     WHEN A NUMERICAL VALUE WAS EXPECTED (NX.NE.0).
C
  560 CONTINUE
      IF(NX.EQ.0) THEN
         IF(C(I).EQ.PERIOD) THEN
            CALL QNZCRD(IRET)
         ELSE
            IF(MASWRK) WRITE(6,9058)
            GO TO 390
         END IF
      ELSE
         GO TO 390
      END IF
C
      CALL QTZLOG(IDLIM,IRET)
      IF (IRET .EQ. 2) GO TO 780
      IF (IRET .EQ. 1) THEN
         IF(MASWRK) WRITE(6,9058)
         GO TO 390
      END IF
      MOD = 0
      RETURN
C
  580 IF (NDIG .NE. 1 .OR. ISIGN .NE. 0 .OR. NPER .NE. 0) GO TO 380
      INTV = INT(S)
      IF (INTV .EQ. 0 .OR. INTV .EQ. 1) GO TO 600
      GO TO 380
C
  600 LOG = .FALSE.
      IF (INTV .EQ. 1) LOG = .TRUE.
      MOD = 0
      GO TO 360
C
C      .....SCAN OFF EXPONENT OF D OR E FIELD
C
  620 IF (NDIG .EQ. 0) GO TO 380
      NDEXP = 0
      IEXP = 0
      ISEXP = 1
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 780
      IF (C(I) .EQ. PLUS) GO TO 660
      IF (C(I) .NE. MINUS) GO TO 680
      ISEXP = -1
  660 CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 780
  680 DO 700 J = 1,10
      IF (C(I) .EQ. DIG(J)) GO TO 720
  700 CONTINUE
      IF (C(I) .EQ. BLANK .OR. C(I) .EQ. COMMA) GO TO 740
      GO TO 380
C
  720 NDEXP = NDEXP+1
      IEXP = IEXP*10+J-1
      GO TO 660
C
  740 IF (NDIG .EQ. 0) GO TO 380
      IEXP = IEXP*ISEXP+(NDIG-NDP)
      DBLV = DBLV*(TEN**(IEXP-NDIG))
      NDIG = 0
      GO TO 500
C
C      ....END OF FILE ON INPUT
C
  780 IRET = 1
      RETURN
C
  800 CONTINUE
      CALL QNZCRD(IRET)
      IF (IRET .EQ. 1) GO TO 780
C
C     ----- PROCESS A CHARACTER STRING -----
C
  820 CONTINUE
      IF (C(I) .EQ. BLANK) GO TO 980
      IF (C(I) .EQ. COMMA) GO TO 980
      IF (C(I) .EQ. DOLLAR) GO TO 980
C
C     ----- CHECK FOR ALPHANUMERIC CHARACTER -----
C          THE PARENS ARE NOT IN THE DIGITS TABLE
      DO 840 K = 1,39
         IF (DIG(K) .EQ. C(I)) GO TO 860
  840 CONTINUE
      IF (C(I) .EQ. LPAREN) GO TO 860
      IF (C(I) .EQ. RPAREN) GO TO 860
C
C     ---- MAYBE A ( OR ) OR =    -----
C
      NDIG = NDIG + 1
C         NEXT TWO MAKE PARENS ILLEGAL IN STRINGS
C-MWS-IF (C(I) .EQ. LPAREN) GO TO 940
C-MWS-IF (C(I) .EQ. RPAREN) GO TO 940
      IF (C(I) .EQ. EQUALS) GO TO 940
      IRET = 2
      IF (MASWRK) WRITE (6,9008)
      GO TO 780
C
  860 CONTINUE
      NDIG = NDIG + 1
      IF (NDIG .LE. 4 .AND. NX .EQ. 4) GO TO 960
      IF (NDIG .LE. 8 .AND. NX .EQ. 5) GO TO 960
C
C     ----- STRING TOO LONG - CHECK TO SEE IF IT'S A VARIABLE
C           NAME -----
C
      KST = I + 1
      IF (KST .GT. 80) GO TO 920
      DO 900 K = KST,80
      IF (C(K) .EQ. EQUALS) GO TO 940
      IF (C(K) .EQ. BLANK) GO TO 900
      DO 880 KK = 1,36
         IF (C(K) .EQ. DIG(KK)) GO TO 900
  880 CONTINUE
C
C     ----- NOT AN =, BLANK OR ALPHANUMERIC, SO IT IS TOO
C           LONG -----
C
      GO TO 920
C
  900 CONTINUE
  920 CONTINUE
      IF (MASWRK) WRITE (6,9028)
      IRET = 2
      GO TO 780
C
  940 CONTINUE
C
C     ----- THIS STRING WAS A VARIABLE NAME, SO BACKSPACE AND
C           REPROCESS AS SUCH -----
C
      IDLIM = I - NDIG + 1
      IF (IDLIM .LT. 1) IDLIM = 80 + IDLIM + 1
      MOD = -2
      RETURN
C
  960 CONTINUE
      CH8(NDIG) = C(I)
      GO TO 800
C
C     ----- PROCESS FINAL CHARACTER OUTPUT -----
C
  980 CONTINUE
C
C     ----- IF NDIG .EQ. 0, THIS MAY BE AN $END -----
C
      IF (NDIG .GT. 0) GO TO 1020
      IF (NDIG .EQ. 0 .AND. C(I) .NE. DOLLAR) GO TO 800
      DO 1000 K = 1,3
         CALL QNZCRD(IRET)
         IF (IRET .EQ. 1) GO TO 780
         IF (C(I) .NE. END(K)) GO TO 380
 1000 CONTINUE
      MOD = -1
      IDLIM = I
      RETURN
C
 1020 CONTINUE
      NLEFT = 8 - NDIG
      IF (NLEFT .EQ. 0) GO TO 1060
      DO 1040 K = 1,NLEFT
      IL = 9 - K
      CH8(IL) = BLANK
 1040 CONTINUE
 1060 CONTINUE
      IDLIM = I
      MOD = 0
      RETURN
C
 9008 FORMAT(/1X,'ILLEGAL CHARACTER FIELD IN NAMELIST')
 9028 FORMAT(/1X,'CHARACTER STRING TOO LONG')
 9048 FORMAT(/1X,'INCORRECT DATA VALUE FOUND')
 9058 FORMAT(/1X,'ILLEGAL LOGICAL INPUT VALUE (MUST BE .T. OR .F. OR',
     *          ' .TRUE. OR .FALSE. ONLY)'/)
      END
C*MODULE NAMEIO  *DECK QVRTZD
      SUBROUTINE QVRTZD(X)
C
C      ----- PROCESS A DOUBLE PRECISION VARIABLE -----
C
      DOUBLE PRECISION X(10),DBL
      LOGICAL   LOG
      REAL CH8,C
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      IF (NREL .EQ. 0) X(1) = DBL
      IF (NREL .GT. 0) X(NREL) = DBL
      RETURN
      END
C*MODULE NAMEIO  *DECK QVRTZI
      SUBROUTINE QVRTZI(N)
C
C      ----- PROCESS AN INTEGER VARIABLE -----
C
      DIMENSION N(10)
C
      DOUBLE PRECISION DBL
      LOGICAL LOG
      REAL CH8,C
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      IF (NREL .EQ. 0) N(1) = INT
      IF (NREL .GT. 0) N(NREL) = INT
      RETURN
      END
C*MODULE NAMEIO  *DECK QVRTZL
      SUBROUTINE QVRTZL(L)
C
C     ----- PROCESS A LOGICAL VARIABLE -----
C
      DOUBLE PRECISION DBL
      LOGICAL L(1)
      LOGICAL LOG
      REAL CH8,C
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      IF (NREL .EQ. 0) L(1) = LOG
      IF (NREL .GT. 0) L(NREL) = LOG
      RETURN
      END
C*MODULE NAMEIO  *DECK QVRTZQ
      SUBROUTINE QVRTZQ(X)
C
C     ----- COPY THE TRANSLATED INPUT TO OUTPUT -----
C
      LOGICAL   LOG
      REAL CH8,C
      DOUBLE PRECISION X(1)
      DOUBLE PRECISION DBL
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      IF (NX .NE. 0) GO TO 100
C
C         OUTPUT IS A LOGICAL VARIABLE
C
         CALL QVRTZL(X)
         RETURN
C
C
  100 CONTINUE
      GO TO (120,140,160,180,200),NX
  120 CONTINUE
C
C      OUTPUT IS IN AN INTEGER
C
      CALL QVRTZI(X)
      RETURN
C
C
  140 CONTINUE
C
C       OUTPUT IS A REAL VARIABLE
C
      CALL QVRTZR(X)
      RETURN
C
C
  160 CONTINUE
C
C       OUTPUT IS A DOUBLE PRECISION VARIABLE
C
      CALL QVRTZD(X)
      RETURN
C
C
  180 CONTINUE
C
C       OUTPUT IS A 4 CHARACTER HOLLERITH VARIABLE
C
      CALL QVRZC4(X)
      RETURN
C
C
  200 CONTINUE
C
C       OUTPUT IS AN 8 CHARACTER HOLLERITH VARIABLE
C
      CALL QVRZC8(X)
      RETURN
      END
C*MODULE NAMEIO  *DECK QVRTZR
      SUBROUTINE QVRTZR(X)
C
C     ----- PROCESS A REAL VARIABLE -----
C
      DOUBLE PRECISION DBL
      LOGICAL   LOG
      REAL CH8,C
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
      DIMENSION X(10)
C
      IF (NREL .EQ. 0) X(1) = REAL
      IF (NREL .GT. 0) X(NREL) = REAL
      RETURN
      END
C*MODULE NAMEIO  *DECK QVRZC4
      SUBROUTINE QVRZC4(CHSTR)
C
      DOUBLE PRECISION DBL
      CHARACTER*4 TEMP
      LOGICAL LOG
      REAL C,CH8,CHSTR(1),CHSTRS(1)
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
C     ----- PROCESS A FOUR CHARACTER STRING -----
C
      WRITE(UNIT=TEMP,FMT='(4A1)') (CH8(K),K=1,4)
      READ (UNIT=TEMP,FMT='(A4)')  CHSTRS
      IF (NREL .EQ. 0) CHSTR(1) = CHSTRS(1)
      IF (NREL .GT. 0) CHSTR(NREL) = CHSTRS(1)
      RETURN
      END
C*MODULE NAMEIO  *DECK QVRZC8
      SUBROUTINE QVRZC8(CHSTR)
C
      DOUBLE PRECISION DBL,CHSTR(1),CHSTRS(1)
      CHARACTER*8 TEMP
      LOGICAL LOG
      REAL C,CH8
C
      COMMON /QQQQZR/ DBL,INT,I,NX,NREL,INPLU,LOG,REAL,C(80),CH8(8)
C
C     ----- PROCESS AN EIGHT CHARACTER STRING -----
C
      WRITE(UNIT=TEMP,FMT='(8A1)') (CH8(K),K=1,8)
      READ (UNIT=TEMP,FMT='(A8)')  CHSTRS
      IF (NREL .EQ. 0) CHSTR(1) = CHSTRS(1)
      IF (NREL .GT. 0) CHSTR(NREL) = CHSTRS(1)
      RETURN
      END
