!IPK  LAST UPDATE JULY 18 1998  MAJOR CHANGES                           
!     Last change:  IPK  12 Jan 98   11:22 am                           
!ipk jan98 delete old call to char(7)                                   
!****************************************************************       
!                                                                       
      SUBROUTINE ADDWID 
!                                                                       
!  Add nodal width data                                                 
!                                                                       
      USE BLK1MOD 
!      INCLUDE 'BLK1.COM' 
!                                                                       
      CHARACTER*1  IFLAG,ANSW(10),ANSW1(10) 
      DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/ 
      DATA ANSW1/   'w','1','2','d','e','s','b','z','r','q'/ 
!                                                                       
    4 CONTINUE 
      NHTP=13 
      NMESS=0 
      NBRR=0 
!ipk apr95 add call to flushwn                                          
      call flushwn 
      CALL HEDR 
  102 IBOX=1 
      CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
        IFLAG=ANSW1(IBOX) 
      ENDIF 
      IF(IFLAG .EQ. 'w') THEN 
!                                                                       
!     get width                                                         
!                                                                       
  104   continue 
        call plotot(1) 
        CALL RCYAN 
        DO  K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .LT. 6) THEN 
              IF(NCORN(K) .GT. 2  .AND.  IMAT(K) .LT. 900) THEN 
                DO  N=1,3,2 
                  J=NOP(K,N) 
                  FPN = WIDTH(J) 
                  X = CORD(J,1) 
                  Y = CORD(J,2) - .11 
                  CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
                enddo 
              ENDIF 
            ENDIF 
          ENDIF 
        enddo 
        CALL RBLUE 
        nmess=45 
        nhtp=0 
        nbrr=4 
        call flushwn 
        CALL HEDR 
        nmess=5 
        xprt=3.2 
        call getfpn(cwid) 
!                                                                       
!  Input new widths                                                     
!                                                                       
  105   IBOX=1 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
          IFLAG=ANSW(IBOX) 
        ENDIF 
        IF(IFLAG .EQ. 'n') THEN 
          GO TO 104 
        ELSEIF(IFLAG .EQ. 'q') THEN 
          CALL WRTOUT(0) 
          go to 4 
        ENDIF 
        XPRT=XPRT+0.5 
        IF(XPRT .GT. HSIZE) XPRT=0. 
        FPN= INODE 
        CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
        IF (IFLAG .EQ. 'c')  THEN 
          WIDTH(INODE) = CWID 
          FPN = WIDTH(INODE) 
          X = CORD(INODE,1) 
          Y = CORD(INODE,2) + .11 
          CALL RRED 
          CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
          CALL RBLUE 
        endif 
        go to 105 
      elseif(iflag .eq. '1') then 
!                                                                       
!     get ss1                                                           
!                                                                       
  204   continue 
        call plotot(1) 
        CALL RCYAN 
        DO  K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .LT. 6) THEN 
              IF(NCORN(K) .GT. 2  .AND.  IMAT(K) .LT. 900) THEN 
                DO  N=1,3,2 
                  J=NOP(K,N) 
                  FPN = ss1(J) 
                  X = CORD(J,1) 
                  Y = CORD(J,2) - .11 
                  CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
                enddo 
              ENDIF 
            ENDIF 
          ENDIF 
        enddo 
        CALL RBLUE 
        nmess=45 
        nhtp=0 
        nbrr=4 
        call flushwn 
        CALL HEDR 
        nmess=22 
        xprt=3.2 
        call getfpn(ss1tp) 
!                                                                       
!  Input new ss1                                                        
!                                                                       
  205   IBOX=1 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
          IFLAG=ANSW(IBOX) 
        ENDIF 
        IF(IFLAG .EQ. 'n') THEN 
          GO TO 204 
        ELSEIF(IFLAG .EQ. 'q') THEN 
          CALL WRTOUT(0) 
          go to 4 
        ENDIF 
        XPRT=XPRT+0.5 
        IF(XPRT .GT. HSIZE) XPRT=0. 
        FPN= INODE 
        CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
        IF (IFLAG .EQ. 'c')  THEN 
          SS1(INODE) = SS1TP 
          FPN = SS1TP 
          X = CORD(INODE,1) 
          Y = CORD(INODE,2) + .11 
          CALL RRED 
          CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
          CALL RBLUE 
        endif 
        go to 205 
      elseif(iflag .eq. '2') then 
!                                                                       
!     get ss2                                                           
!                                                                       
  304   continue 
        call plotot(1) 
        CALL RCYAN 
        DO  K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .LT. 6) THEN 
              IF(NCORN(K) .GT. 2  .AND.  IMAT(K) .LT. 900) THEN 
                DO  N=1,3,2 
                  J=NOP(K,N) 
                  FPN = ss2(J) 
                  X = CORD(J,1) 
                  Y = CORD(J,2) - .11 
                  CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
                enddo 
              ENDIF 
            ENDIF 
          ENDIF 
        enddo 
        CALL RBLUE 
        nmess=45
        nhtp=0 
        nbrr=4 
        call flushwn 
        CALL HEDR 
        nmess=23 
        xprt=3.2 
        call getfpn(ss2tp) 
!                                                                       
!  Input new ss2                                                        
!                                                                       
  305   IBOX=1 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
          IFLAG=ANSW(IBOX) 
        ENDIF 
        IF(IFLAG .EQ. 'n') THEN 
          GO TO 304 
        ELSEIF(IFLAG .EQ. 'q') THEN 
          CALL WRTOUT(0) 
          go to 4 
        ENDIF 
        XPRT=XPRT+0.5 
        IF(XPRT .GT. HSIZE) XPRT=0. 
        FPN= INODE 
        CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
        IF (IFLAG .EQ. 'c')  THEN 
          SS2(INODE) = SS2TP 
          FPN = SS2TP 
          X = CORD(INODE,1) 
          Y = CORD(INODE,2) + .11 
          CALL RRED 
          CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
          CALL RBLUE 
        endif 
        go to 305 
      elseif(iflag .eq. 'd') then 
!                                                                       
!     get storage width                                                 
!                                                                       
  404   continue 
        call plotot(1) 
        CALL RCYAN 
        DO  K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .LT. 6) THEN 
              IF(NCORN(K) .GT. 2  .AND.  IMAT(K) .LT. 900) THEN 
                DO  N=1,3,2 
                  J=NOP(K,N) 
                  FPN = wids(J) 
                  X = CORD(J,1) 
                  Y = CORD(J,2) - .11 
                  CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
                enddo 
              ENDIF 
            ENDIF 
          ENDIF 
        enddo 
        CALL RBLUE 
        nmess=45
        nhtp=0 
        nbrr=4 
        call flushwn 
        CALL HEDR 
        nmess=24 
        xprt=3.2 
        call getfpn(wids1tp) 
!                                                                       
!  Input new storgae width                                              
!                                                                       
  405   IBOX=1 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
          IFLAG=ANSW(IBOX) 
        ENDIF 
        IF(IFLAG .EQ. 'n') THEN 
          GO TO 404 
        ELSEIF(IFLAG .EQ. 'q') THEN 
          CALL WRTOUT(0) 
          go to 4 
        ENDIF 
        XPRT=XPRT+0.5 
        IF(XPRT .GT. HSIZE) XPRT=0. 
        FPN= INODE 
        CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
        IF (IFLAG .EQ. 'c')  THEN 
          WIDS(INODE) = wids1TP 
          FPN = wids1TP 
          X = CORD(INODE,1) 
          Y = CORD(INODE,2) + .11 
          CALL RRED 
          CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
          CALL RBLUE 
        endif 
        go to 405 
      elseif(iflag .eq. 'e') then 
!                                                                       
!     get storage elevation                                             
!                                                                       
  504   continue 
        call plotot(1) 
        CALL RCYAN 
        DO  K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .LT. 6) THEN 
              IF(NCORN(K) .GT. 2  .AND.  IMAT(K) .LT. 900) THEN 
                DO  N=1,3,2 
                  J=NOP(K,N) 
                  FPN = widbs(J) 
                  X = CORD(J,1) 
                  Y = CORD(J,2) - .11 
                  CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
                enddo 
              ENDIF 
            ENDIF 
          ENDIF 
        enddo 
        CALL RBLUE 
        nmess=45
        nhtp=0 
        nbrr=4 
        call flushwn 
        CALL HEDR 
        nmess=39 
        xprt=3.2 
        call getfpn(widbs1tp) 
!                                                                       
!  Input new storage elevations                                         
!                                                                       
  505   IBOX=1 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
          IFLAG=ANSW(IBOX) 
        ENDIF 
        IF(IFLAG .EQ. 'n') THEN 
          GO TO 504 
        ELSEIF(IFLAG .EQ. 'q') THEN 
          CALL WRTOUT(0) 
          go to 4 
        ENDIF 
        XPRT=XPRT+0.5 
        IF(XPRT .GT. HSIZE) XPRT=0. 
        FPN= INODE 
        CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
        IF (IFLAG .EQ. 'c')  THEN 
          WIDBS(INODE) = widbs1TP 
          FPN = widbs1tp 
          X = CORD(INODE,1) 
          Y = CORD(INODE,2) + .11 
          CALL RRED 
          CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
          CALL RBLUE 
        endif 
        go to 505 
      elseif(iflag .eq. 's') then 
!                                                                       
!     get storage slopes                                                
!                                                                       
  604   continue 
        call plotot(1) 
        CALL RCYAN 
        DO  K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .LT. 6) THEN 
              IF(NCORN(K) .GT. 2  .AND.  IMAT(K) .LT. 900) THEN 
                DO  N=1,3,2 
                  J=NOP(K,N) 
                  FPN = sso(J) 
                  X = CORD(J,1) 
                  Y = CORD(J,2) - .11 
                  CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
                enddo 
              ENDIF 
            ENDIF 
          ENDIF 
        enddo 
        CALL RBLUE 
        nmess=45 
        nhtp=0 
        nbrr=4 
        call flushwn 
        CALL HEDR 
        nmess=40 
        xprt=3.2 
        call getfpn(widslp) 
!                                                                       
!  Input new storage slopes                                             
!                                                                       
  605   IBOX=1 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
          IFLAG=ANSW(IBOX) 
        ENDIF 
        IF(IFLAG .EQ. 'n') THEN 
          GO TO 604 
        ELSEIF(IFLAG .EQ. 'q') THEN 
          CALL WRTOUT(0) 
          go to 4 
        ENDIF 
        XPRT=XPRT+0.5 
        IF(XPRT .GT. HSIZE) XPRT=0. 
        FPN= INODE 
        CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
        IF (IFLAG .EQ. 'c')  THEN 
          SSO(INODE) = widslp 
          FPN = widslp 
          X = CORD(INODE,1) 
          Y = CORD(INODE,2) + .11 
          CALL RRED 
          CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
          CALL RBLUE 
        endif 
        go to 605 
!ipk mar02                                                                        
!                                                                       
!     get bed slopes                                                
!                                                                       
      elseif(iflag .eq. 'b') then 
  704   continue 
        call plotot(1) 
        CALL RCYAN 
        DO  K=1,NE 
          IF(IMAT(K) .GT. 0) THEN 
            IF(NCORN(K) .LT. 6) THEN 
              IF(NCORN(K) .GT. 2  .AND.  IMAT(K) .LT. 900) THEN 
                DO  N=1,3,2 
                  J=NOP(K,N) 
                  FPN = BS1(J) 
                  X = CORD(J,1) 
                  Y = CORD(J,2) - .11 
                  CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
                enddo 
              ENDIF 
            ENDIF 
          ENDIF 
        enddo 
        CALL RBLUE 
        nmess=45
        nhtp=0 
        nbrr=4 
        call flushwn 
        CALL HEDR 
        nmess=44
        xprt=3.2 
        call getfpn(bedslp) 
!                                                                       
!  Input new bed slopes                                             
!                                                                       
  705   IBOX=1 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
        IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
          IFLAG=ANSW(IBOX) 
        ENDIF 
        IF(IFLAG .EQ. 'n') THEN 
          GO TO 704 
        ELSEIF(IFLAG .EQ. 'q') THEN 
          CALL WRTOUT(0) 
          go to 4 
        ENDIF 
        XPRT=XPRT+0.5 
        IF(XPRT .GT. HSIZE) XPRT=0. 
        FPN= INODE 
        CALL NUMBR(XPRT,7.20,0.20,FPN,0.0,-1) 
        IF (IFLAG .EQ. 'c')  THEN 
          BS1(INODE) = bedslp 
          FPN = bedslp 
          X = CORD(INODE,1) 
          Y = CORD(INODE,2) + .11 
          CALL RRED 
          CALL NUMBR(X,Y,0.20,FPN,0.0,-1) 
          CALL RBLUE 
        endif 
        go to 705 
        
      elseif(iflag .eq. 'q') then 
        return 
      endif 
      go to 4 
      END