      SUBROUTINE QSURCH
     I                  (MESSFL,SCLU,NUMRCH,NUMHDW,METFLG,LCMPEL,
     M                   RCHNAM,DAT2,DAT9,NCMPEL,CMPELF,IRET)
C
C     + + + PURPOSE + + +
C     set up reach id data
C
C     + + + DUMMY ARGUMENTS + + +
      INTEGER     MESSFL,SCLU,NUMRCH,NUMHDW,METFLG,
     1            NCMPEL(NUMRCH),CMPELF(20,NUMRCH),IRET
      REAL        LCMPEL,DAT2(3,NUMRCH),DAT9(4,NUMHDW)
      CHARACTER*1 RCHNAM(16,NUMRCH)
C
C     + + + ARGUMENT DEFINITIONS + + +
C     MESSFL - Fortran unit number for message file
C     SCLU   - cluster number on message file
C     NUMRCH - number of reaches
C     NUMHDW - number of headwaters
C     METFLG - input metric units flag (0 - no, 1 - yes)
C     LCMPEL - length of computational element
C     RCHNAM - array of reach names
C     DAT2   - array of reach data (start/end river miles)
C     DAT9   - array of junction data
C     NCMPEL - array of number of computational elements for each reach
C     CMPELF - array of computational element flags for each reach
C     IRET   - user's exit command from full screen
C
C     + + + LOCAL VARIABLES + + +
C-DWD
C-DWD ##### Begin change ############################
C-DWD Date: Monday, 28 October 1991.  Time: 07:41:15.
C-DWD -----------------------------------------------
C-DWD Modified parameter values to match QUAL2E MAIN.VAR file.
C-DWD
      INTEGER     I,I0,I1,J,K,L,SGRP,TLEN,JUST,RNUM,ITMP,HEADFG,
     1            ERRFLG,ORDER,MXLIN,SCNINI,LINCNT,IVAL(2),
     2            CVAL(1,3,200),LSTELM(200),TMPJUN(19),SRTJUN(19)
      REAL        TMPLOC(19),RTMP,R1
C     2            CVAL(1,3,50),LSTELM(50),TMPJUN(19),SRTJUN(19)
C      INTEGER     I,I0,I1,J,K,L,SGRP,TLEN,JUST,RNUM,ITMP,HEADFG,
C     1            ERRFLG,ORDER,MXLIN,SCNINI,LINCNT,IVAL(2),
C     2            CVAL(1,3,1),LSTELM(50),TMPJUN(9),SRTJUN(9)
C      REAL        TMPLOC(9),RTMP,R1
C-DWD
C-DWD ##### End change ##############################
      DOUBLE PRECISION DVAL(1,1)
      CHARACTER*1 SCHRBF(42,225)
C      CHARACTER*1 SCHRBF(42,75)
C
C     + + + INTRINSICS + + +
      INTRINSIC   MOD, ABS
C
C     + + + EXTERNALS + + +
      EXTERNAL    CHRCHR, DECCHR, QRESCZ, QRESPI, QRESPR, ASRTI
      EXTERNAL    ZGTRET, PMXTXI, PMXTXR, PRNTXT, PMXCNW
C
C     + + + END SPECIFICATIONS + + +
C
      I0  = 0
      I1  = 1
      JUST= 0
      ERRFLG= 1
 51   CONTINUE
        IF (ERRFLG.NE.0) THEN
C         need to ask user about form5
          DO 52 I= 1, NUMRCH
            TLEN= 16
            CALL CHRCHR(TLEN,RCHNAM(1,I),SCHRBF(7,I))
            TLEN= 6
            CALL DECCHR (DAT2(1,I),TLEN,JUST,K,SCHRBF(1,I))
            TLEN= 10
            CALL DECCHR (DAT2(2,I),TLEN,JUST,K,SCHRBF(23,I))
            CALL DECCHR (DAT2(3,I),TLEN,JUST,K,SCHRBF(33,I))
52        CONTINUE
          TLEN= 42
          RNUM= 3
          SGRP= 2+ METFLG
          CALL QRESCZ (MESSFL,SCLU,SGRP,I1,RNUM,I1,I1,NUMRCH,I1,TLEN,
     M                 IVAL,DAT2,DVAL,CVAL,SCHRBF)
          TLEN= 16
          DO 53 I= 1, NUMRCH
            CALL CHRCHR(TLEN,SCHRBF(7,I),RCHNAM(1,I))
53        CONTINUE
C         get user exit command
          CALL ZGTRET(IRET)
        END IF
C
        IF (IRET.EQ.1) THEN
C         detailed check of parameters from form 5
          ERRFLG= 0
          SCNINI= 1
          DO 54 I= 1, NUMRCH
C           calc number of comp elem in each reach
            RTMP= (DAT2(2,I)-DAT2(3,I))/ LCMPEL
            R1  = 1.0
            IF (MOD(RTMP,R1).GT.0.95) RTMP= RTMP+ 0.05
            NCMPEL(I)= RTMP
C           do checks within each reach
            IF (DAT2(2,I).LE.DAT2(3,I)) THEN
C             headwater must be greater than end
              IF (ERRFLG.EQ.0) ERRFLG= 1
              SGRP= 4
              CALL PMXTXR(MESSFL,SCLU,SGRP,MXLIN,SCNINI,I1,
     I                    I1,DAT2(1,I))
C             add to this message next time
              SCNINI= -1
            ELSE IF (NCMPEL(I).GT.20) THEN
C             too many computation elements
              ERRFLG= 2
              SGRP  = 5
              CALL PMXTXR(MESSFL,SCLU,SGRP,MXLIN,SCNINI,I1,
     I                    I1,DAT2(1,I))
C             add to this message next time
              SCNINI= -1
            END IF
54        CONTINUE
          IF (ERRFLG.EQ.0) THEN
C           do checks between reaches
            ORDER= 0
            LSTELM(1)= NCMPEL(1)
C           count headwaters, first reach always one
            CMPELF(1,1)= 1
            J= 1
            IF (NUMRCH.GT.1) THEN
              DO 56 I= 2, NUMRCH
                LSTELM(I)= LSTELM(I-1)+ NCMPEL(I)
C               is this reach a headwater
                IF (ABS(DAT2(2,I)-DAT2(3,I-1)).GT.1.0E-3) THEN
C                 may be a headwater
                  IF (ORDER.EQ.0) THEN
C                   first time, must be a headwater
                    HEADFG= 1
                  ELSE
C                   assume its a headwater
                    HEADFG= 1
                    K= ORDER
 55                 CONTINUE
                      IF (ABS(TMPLOC(K)-DAT2(2,I)).LT.1.0E-3) THEN
C                       matches previous end of reach, must be a junction
                        HEADFG= 0
                      ELSE
                        K= K- 1
                      END IF
                    IF (K.GT.0 .AND. HEADFG.EQ.1) GO TO 55
                  END IF
                  IF (HEADFG.EQ.1) THEN
C                   headwater
                    J= J+ 1
C                   indicate headwater cmpel flg
                    CMPELF(1,I)= 1
C                   indicate ups of jun cmpel flg
                    CMPELF(NCMPEL(I-1),I-1)= 3
C                   increment stream order number
                    ORDER= ORDER+ 1
C                   save upstr element number
                    DAT9(2,J-1)= LSTELM(I-1)
C                   save location of this element
                    TMPLOC(ORDER)= DAT2(3,I-1)
C                   save junction number
                    TMPJUN(ORDER)= J-1
                  ELSE
C                   at the junction from trib
C                   save downstream element number
                    DAT9(3,TMPJUN(K))= LSTELM(I-1)+ 1
C                   save trib element number
                    DAT9(4,TMPJUN(K))= LSTELM(I-1)
C                   decrement stream order number
                    ORDER= ORDER- 1
C                   indicate junction cmpel flg
                    CMPELF(1,I)= 4
                  END IF
                END IF
 56           CONTINUE
              DO 57 I= 1,J-1
                TMPJUN(I)= DAT9(3,I)
 57           CONTINUE
              IF (J.GT.1) THEN
C               sort by downstream element
                CALL ASRTI(I0,J-1,TMPJUN,
     O                     SRTJUN)
C               move to revised positions
                DO 59 I= 1,J-1
                  IF (SRTJUN(I).NE.I) THEN
                    DO 58 K= 2,4
                      ITMP= DAT9(K,I)
                      DAT9(K,I)= DAT9(K,SRTJUN(I))
                      DAT9(K,SRTJUN(I))= ITMP
 58                 CONTINUE
                    L= I
 585                CONTINUE
                      L= L+ 1
                    IF (SRTJUN(L).NE.I) GO TO 585
                    SRTJUN(L)= SRTJUN(I)
                    SRTJUN(I)= I
                  END IF
 59             CONTINUE
              END IF
            END IF
C           indicate downstream cmpel flg
            CMPELF(NCMPEL(NUMRCH),NUMRCH)= 5
            IF (J.NE.NUMHDW) THEN
C             conflicting number of headwaters
              IVAL(1)= J
              IVAL(2)= NUMHDW
              SGRP   = 6
              I      = 2
              CALL PMXTXI(MESSFL,SCLU,SGRP,MXLIN,SCNINI,I0,I,IVAL)
C             how many headwaters do you really have?
              SGRP= 7
              CALL QRESPI (MESSFL,SCLU,SGRP,NUMHDW)
              IF (J.NE.NUMHDW) THEN
C               river locs must match, try table again
                SGRP= 8
                CALL PRNTXT (MESSFL,SCLU,SGRP)
                ERRFLG= 1
              END IF
            END IF
          END IF
          IF (ERRFLG.EQ.2) THEN
C           change length of comp element
            SGRP= 9
            CALL QRESPR (MESSFL,SCLU,SGRP,LCMPEL)
C           initialize screen next time
            SCNINI= 1
          END IF
          IF (ERRFLG.NE.0) THEN
C           must get this table right
            SGRP= 10
            CALL PMXCNW (MESSFL,SCLU,SGRP,MXLIN,SCNINI,I0,
     O                   LINCNT)
          END IF
        ELSE
C         user wants previous screen
          ERRFLG= 0
        END IF
      IF (ERRFLG.NE.0) GO TO 51
C
      RETURN
      END
