      SUBROUTINE QUNCAS
     I                  (MESSFL,NUMRCH,NCMPEL)
C
C     + + + PURPOSE + + +
C     routine for uncertainty analysis specifications file
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER     MESSFL,NUMRCH,NCMPEL(NUMRCH)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     MESSFL - unit number for message file
C     NUMRCH - number of reaches
C     NCMPEL - array of computational elements for each reach
C
C     + + + COMMON BLOCK + + +
      INCLUDE 'CUNCAS.INC'
C
C     + + + LOCAL VARIABLES + + +
      INTEGER      I,J,I8,I80,I1,K,L,SCLU,SGRP,RESP,RETCOD,
     1             UNCARD,OFFSET,LEN,CNUM,NMVRS,NMRNS,INO,
     2             ARRYCK,IVRCNT,IND,INDX,INVRFL,SAVFG,EDITFG,
     3             IMIN,IDEF,IMAX,DONFG,FLERR,UNCFIL,INIT,JUST,
     4             VARPOS(150),IVAL(1,5),CVAL(7,3),IWRT,LCLU
      REAL         RVAL(1,5),R0
      CHARACTER*1  BLNK,INVRNM(8,150),SCHRBF(80,5),FLNAME(64)
      CHARACTER*64 VRFLNM
C
C     + + + FUNCTIONS + + +
      REAL         CHRDEC
C
C     + + + EXTERNALS + + +
      EXTERNAL     UNCINI, QRESP, QFOPEN, QFCLOS, UNCREA, UNCWRT, VRCDHP
      EXTERNAL     PRNTXT, QRESPI, QTSTR, QRESPR, QRESCX, CHRCHR
      EXTERNAL     PRNTXI, DECCHR, ZIPR, CHRSRT, CHRCHK, CHRDEC, PMXTXI
      EXTERNAL     QRESCN, ZIPI, ZIPC, QRSPUI, PMXCNW, ZMNSST
C
C     + + + DATA INITIALIZATIONS + + +
      SAVE INVRNM,IVRCNT,VARPOS
      DATA IVRCNT/0/
C
C     + + + OUTPUT FORMATS + + +
 2000 FORMAT (64A1)
C
C     + + + END SPECIFICATIONS + + +
C
C     initialize all parameters
      SCLU= 20
      INO = -999
      I1  = 1
      I8  = 8
      I80 = 80
      R0  = 0.
      BLNK= ' '
      INVRFL= 14
      ARRYCK= 0
      I= 5* 80
      CALL ZIPC (I,BLNK,SCHRBF)
C
C     initialize all UNCAS variables
      CALL UNCINI (MESSFL,SCLU)
C
      IF (IVRCNT.EQ.0) THEN
C       first time through, read in variable codes from INVAR.DAT
        VRFLNM= 'INVAR.DAT'
        FLERR = 0
        RESP  = 1
 2      CONTINUE
          IF (FLERR.EQ.1) THEN
C           could not open INVAR.DAT
            SGRP= 49
            CALL PRNTXT (MESSFL,SCLU,SGRP)
            CALL ZMNSST
C           see if user wants to try another path name
            SGRP= 50
            CALL QRESP (MESSFL,SCLU,SGRP,RESP)
            IF (RESP.EQ.1) THEN
C             ask user to specify full path name
              SGRP= 51
              LEN = 64
              CALL QTSTR (MESSFL,SCLU,SGRP,LEN,FLNAME)
              WRITE (VRFLNM,2000) (FLNAME(I),I=1,LEN)
            END IF
          END IF
          FLERR= 0
          IF (RESP.EQ.1) THEN
C           try to open using new name
            INIT= 0
            IWRT= 1
            SGRP= 48
            CALL PMXCNW (MESSFL,SCLU,SGRP,I8,INIT,IWRT,J)
            OPEN (INVRFL,FILE=VRFLNM,STATUS='OLD',ERR=4)
          END IF
          GO TO 6
 4        CONTINUE
            FLERR= 1
 6        CONTINUE
        IF (FLERR.EQ.1) GO TO 2
        IF (RESP.EQ.1) THEN
C         INVAR.DAT opened, create pointer to INVRNM using bubble sort
          CALL CHRSRT (INVRFL,
     O                 INVRNM,IVRCNT,VARPOS)
        ELSE
C         INVAR.DAT not opened, print message to user
          SGRP= 52
          CALL PRNTXT (MESSFL,SCLU,SGRP)
        END IF
      END IF
      SAVFG= 1
C
 5    CONTINUE
C       setup, edit or save?
        SGRP= 1
        CALL QRESP (MESSFL,SCLU,SGRP,RESP)
        IF (RESP.EQ.1) THEN
C         work from new file
          RETCOD= 1
        ELSE IF (RESP.EQ.2) THEN
C         try to open old file
          SGRP= 44
          CALL QFOPEN (MESSFL,SCLU,SGRP,UNCFIL,RETCOD)
          IF (RETCOD.EQ.0) THEN
C           fill in UNCAS common block with old file values
            CALL UNCREA (MESSFL,SCLU,UNCFIL,
     M                   RETCOD)
            I= 0
            CALL QFCLOS (UNCFIL,I)
            EDITFG= 1
          END IF
        ELSE IF (RESP.EQ.3) THEN
C         write out file - first try to open
          SGRP= 45
          CALL QFOPEN (MESSFL,SCLU,SGRP,UNCFIL,RETCOD)
          CALL UNCWRT (MESSFL,SCLU,UNCFIL)
          I= 0
          CALL QFCLOS (UNCFIL,I)
          SAVFG= 1
        ELSE IF (RESP.EQ.4) THEN
C         all done, is everything saved?
          IF (SAVFG.EQ.0) THEN
C           let user know files unsaved and verify exit
            LCLU= 19
            SGRP= 8
            CALL QRESP (MESSFL,LCLU,SGRP,RESP)
            IF (RESP.EQ.1) THEN
C             dont exit, go back and save
              RESP= 3
            ELSE
C             want to exit no matter what
              RESP= 4
            END IF
          END IF
        END IF
C
        IF (RESP.EQ.1 .OR. RESP.EQ.2) THEN
C         edit data, either new or old file
          SAVFG = 0
          UNCARD= 1
 7        CONTINUE
            IF (EDITFG.EQ.1) THEN
C             which card to edit
              SGRP= 2
              CALL QRESP(MESSFL,SCLU,SGRP,UNCARD)
            END IF
            GO TO (10,20,30,40,50,60,70,80), UNCARD
C
 10         CONTINUE
C             get system title
              LEN = 50
              SGRP= 3
              CALL QTSTR (MESSFL,SCLU,SGRP,LEN,
     O                    UNCTTL)
              UNCARD= UNCARD+ 1
              GO TO 100
C
 20         CONTINUE
C             get uncertainty analysis option
              SGRP= 4
              CALL QRESP (MESSFL,SCLU,SGRP,UNCOPT)
              IF (UNCOPT.EQ.2) THEN
C               1st order error analysis - get % perturbation
                SGRP= 5
                CALL QRESPR (MESSFL,SCLU,SGRP,PERTRB)
              ELSE IF (UNCOPT.EQ.3) THEN
C               monte carlo simulation - get no. of simulations
                SGRP= 6
                CALL QRESPI (MESSFL,SCLU,SGRP,NMSIMS)
              END IF
              UNCARD= UNCARD+ 1
              GO TO 100
C
 30         CONTINUE
C             get input condition
              IF (UNCOPT.EQ.1) THEN
C               Sensitivity option, only Single and 2-level as options
                SGRP= 7
              ELSE
C               1st order/Monte Carlo, only Generic/All as options
                SGRP= 41
                IF (INPCND.GT.2) INPCND= INPCND- 2
              END IF
              CALL QRESP (MESSFL,SCLU,SGRP,INPCND)
              IF (UNCOPT.GT.1) INPCND= INPCND+ 2
              IF (INPCND.EQ.2) THEN
C               2-level factorial design - get no. of variables
                SGRP= 8
                CALL QRESPI (MESSFL,SCLU,SGRP,NUMVAR)
              ELSE IF (INPCND.EQ.4) THEN
C               get generic groups
                DO 32 I= 1,7
                  CVAL(I,1)= IGNGRP(I)
32              CONTINUE
                CNUM= 7
                SGRP= 9
                CALL QRESCN (MESSFL,SCLU,SGRP,I1,I1,CNUM,I1,I1,
     M                       IVAL,RVAL,CVAL,SCHRBF)
                DO 36 I= 1,7
                  IGNGRP(I)= CVAL(I,1)
 36             CONTINUE
              END IF
              UNCARD= UNCARD+ 1
              GO TO 100
C
 40         CONTINUE
C             intermediate output
              IF (UNCOPT.EQ.3) THEN
C               Monte Carlo simulation, no intermediate output allowed
                INTOUT= 1
              ELSE
C               get intermediate output from user
                SGRP= 10
                CALL QRESP (MESSFL,SCLU,SGRP,INTOUT)
              END IF
              UNCARD= UNCARD+ 1
              GO TO 100
C
 50         CONTINUE
C             get output variables
              DO 54 I= 1,3
                CVAL(I,1)= IOUTVR(I)
 54           CONTINUE
              CNUM= 3
              SGRP= 11
              CALL QRESCN (MESSFL,SCLU,SGRP,I1,I1,CNUM,I1,I1,
     M                     IVAL,RVAL,CVAL,SCHRBF)
              DO 58 I= 1,3
                IOUTVR(I)= CVAL(I,1)
 58           CONTINUE
              UNCARD= UNCARD+ 1
              GO TO 100
C
 60         CONTINUE
C             get output locations
              I     = 0
              J     = 0
              DONFG = 0
 65           CONTINUE
                I   = I+ 1
                J   = J+ 1
                SGRP= 46
                CALL PMXTXI (MESSFL,SCLU,SGRP,I1,I1,-I1,I1,J)
C               save message text
                CALL ZMNSST
C               get reach number
                SGRP= 47
C               initialize min, max, def
                IMIN= 0
                IMAX= NUMRCH
                IDEF= 0
                CALL QRSPUI (MESSFL,SCLU,SGRP,IMIN,IMAX,IDEF,
     M                       OUTLCS(I))
                IF (OUTLCS(I).GT.0) THEN
C                 not quiting yet, get element number
                  I   = I+ 1
C                 get element number
                  SGRP= 12
C                 initialize min, max, def
                  IMIN= 1
                  IMAX= NCMPEL(OUTLCS(I-1))
                  IDEF= 1
                  CALL QRSPUI (MESSFL,SCLU,SGRP,IMIN,IMAX,IDEF,
     M                         OUTLCS(I))
                ELSE
                  DONFG= 1
                END IF
              IF (DONFG.NE.1.AND.J.LT.5) GO TO 65
              UNCARD= UNCARD+ 1
              GO TO 100
C
 70         CONTINUE
              IF (UNCOPT.EQ.1) THEN
C               get number of input sensitivity runs
                NMRNS= NMSENS
                SGRP = 13
                CALL QRESPI (MESSFL,SCLU,SGRP,NMRNS)
C
                IF (NMRNS.NE.NMSENS) THEN
C                 clear arrays, data is significantly different
                  I= 5* NMRNS
                  CALL ZIPI (I,INO,INVRTP)
                  CALL ZIPR (I,R0,PRCPRT)
                  CALL ZIPC (I8*I,BLNK,VARCOD)
                  NMSENS= NMRNS
                  ARRYCK= 1
                END IF
C
                VRCNT(1)= 1
                DO 78 I= 1,NMSENS
C                 which type of input variables
                  SGRP= 38
                  CALL PMXTXI (MESSFL,SCLU,SGRP,I8,I1,-I1,I1,I)
C                 save message text
                  CALL ZMNSST
                  SGRP= 14
                  CALL QRESP (MESSFL,SCLU,SGRP,INVRTP(I))
C
                  IF (INVRTP(I).EQ.1) THEN
C                   single input variables
                    NMVRS= 1
                  ELSE
C                   multiple or factorial input variables - get no of variables
                    NMVRS= NMINVR(I)
                    SGRP = 15
                    CALL QRESPI (MESSFL,SCLU,SGRP,NMVRS)
                  END IF
C
                  IF (ARRYCK.EQ.0.AND.RETCOD.EQ.0) THEN
C                   reading old data, check to see if arrays need adjusting
                    IF (NMVRS.NE.NMINVR(I).AND.I.NE.NMSENS) THEN
C                     adjust arrays
                      OFFSET= NMVRS- NMINVR(I)
                      IF (OFFSET.GT.0) THEN
                        IF (I.EQ.NMSENS) VRCNT(I+1)= VRCNT(I)
                        DO 71 K= VRCNT(NMSENS)+NMINVR(NMSENS)-1,
     1                           VRCNT(I+1),-1
                          PRCPRT(K+OFFSET)= PRCPRT(K)
                          LEN= 8
                          CALL CHRCHR (LEN,VARCOD(1,K),
     M                                 VARCOD(1,K+OFFSET))
 71                     CONTINUE
                        CALL ZIPC (I8*OFFSET,BLNK,
     M                             VARCOD(1,VRCNT(I)+NMINVR(I)))
                        CALL ZIPR (OFFSET,R0,
     M                             PRCPRT(VRCNT(I)+NMINVR(I)))
                      ELSE
                        DO 72 K= VRCNT(I+1),
     1                           VRCNT(NMSENS)+NMINVR(NMSENS)-1
                          PRCPRT(K+OFFSET)= PRCPRT(K)
                          LEN= 8
                          CALL CHRCHR (LEN,VARCOD(1,K),
     M                                 VARCOD(1,K+OFFSET))
 72                     CONTINUE
                      END IF
                      IF (NMSENS.GT.1) THEN
                        DO 73 K= NMSENS,I+1,-1
                          VRCNT(K)= VRCNT(K)+ OFFSET
 73                     CONTINUE
                      END IF
                    END IF
                  ELSE
C                   new data to be entered
                    IF (I.GT.1) VRCNT(I)= VRCNT(I-1)+ NMINVR(I-1)
                  END IF
                  NMINVR(I)= NMVRS
C                 get input variables for each sensitivity runs
                  DO 75 K= 1,NMINVR(I)
                    INDX= VRCNT(I)+ K- 1
                    IND = 1
 74                 CONTINUE
                      IF (IND.EQ.0) THEN
C                       bad response, dont clear message from CHRCHK
                        INIT= -1
                        CALL ZMNSST
                      END IF
                      SGRP= 39
                      CALL PMXTXI (MESSFL,SCLU,SGRP,I1,INIT,-I1,I1,K)
C                     save message text
                      CALL ZMNSST
                      SGRP= 40
                      CALL QTSTR (MESSFL,SCLU,SGRP,I8-1,VARCOD(1,INDX))
                      CALL CHRCHK (MESSFL,SCLU,IVRCNT,INVRNM,
     M                             VARCOD(1,INDX),
     O                             IND)
                    IF (IND.EQ.0) GO TO 74
                    LEN = 8
                    CALL CHRCHR (LEN,VARCOD(1,INDX),SCHRBF(1,K))
                    LEN = 6
                    JUST= 0
                    CALL DECCHR (PRCPRT(INDX),LEN,JUST,L,SCHRBF(9,K))
 75               CONTINUE
                  SGRP= 16
                  CALL QRESCX (MESSFL,SCLU,SGRP,I1,I1,I1,NMINVR(I),I1,
     M                         IVAL,PRCPRT(VRCNT(I)),CVAL,SCHRBF)
                  DO 77 K= 1,NMINVR(I)
                    INDX= VRCNT(I)+ K- 1
                    LEN = 8
                    CALL CHRCHR (LEN,SCHRBF(1,K),VARCOD(1,INDX))
                    LEN = 6
                    JUST= 0
                    PRCPRT(INDX)= CHRDEC(LEN,SCHRBF(9,K))
 77               CONTINUE
 78             CONTINUE
              END IF
              UNCARD= UNCARD+ 1
              GO TO 100
C
 80         CONTINUE
C             done editing data
              GO TO 100
C
 100        CONTINUE
          IF (UNCARD.NE.8) GO TO 7
C         set default response to Save data
          RESP= 3
        END IF
C
      IF (RESP.NE.4) GO TO 5
C
      RETURN
      END
