!IPK  LAST UPDATE SEP 23 2015  ADD TESTING FOR CHNAGED ELEMENTS/NODES
!     Last change:  IPK  13 Jan 98   10:01 am                           
!ipk  last update to add deletion opton when moving nodes               
!ipk  last update Jan 12 1998                                           
!ipk  last update Nov18 1997                                            
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE ADDNOD 
!                                                                       
!  Input additional node locations from screen                          
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

!IPK MAY02
      INCLUDE 'TXFRM.COM'
!                                                                       
      CHARACTER*1  IFLAG,ANS,ANSW(0:9) 
      CHARACTER*32 JUNK 
      CHARACTER*20 NODH 
!ipk jan98                                                              
      CHARACTER*80 LIND 
      DATA ANSW/'a','m','d','f','g','e','h','z','r','q'/ 
      data itime/0/
      
      if(itime .eq. 0) then
      nodsh=1
      itime=1
      endif
      ISWT=3
!                                                                       
!  Draw box around selections                                           
!                                                                       
    2 CONTINUE 
      NHTP=4 
      NMESS=0 
      NBRR=0 
      CALL HEDR 
!                                                                       
!  Get answer                                                           
!                                                                       
    3 call xyloc(XPT,YPT,ANS,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      
      IF(ANS .EQ. 'c') THEN 
        if(ibox .eq. 0) go to 3
        I=IBOX-1 
        ANS=ANSW(I) 
      ENDIF 
!                                                                       
      IF(ANS .EQ. 'a') THEN 
        ISWT=1 
        NHTP=0 
        NBRR=0 
        NMESS=16 
      ELSEIF(ANS .EQ. 'm') THEN 
        ISWT=0 
        NHTP=0 
        NBRR=0 
        NMESS=17 
      ELSEIF(ANS .EQ. 'd') THEN 
!                                                                       
!     Call deleting operations                                          
!                                                                       
        CALL DELOP 
        IF(IRMAIN .EQ. 1) RETURN 
        GO TO 2 
      ELSEIF(ANS .EQ. 'e') THEN 
        CALL GRIDSB(0)
        IF(IRMAIN .EQ. 1) RETURN 
        GO TO 2 
      ELSEIF(ANS .EQ. 'q') THEN 
        RETURN 
      ELSEIF(ANS .EQ. 'f') THEN 
!                                                                       
!  Search for a plot a grid centered around a node                      
!                                                                       
        NHTP=0 
        NBRR=0 
        NMESS=1
        CALL HEDR 
        NMESS=1 
        CALL GETINT(NODSH) 
        IF(INEW(NODSH) .LE. 0) GO TO 2 
        DO 4 I=1,NP 
          IF(CORD(I,1) .GT. VOID) THEN 
            INSKP(I)=0 
          ENDIF 
    4   CONTINUE 
        DO 5 I=1,NE 
          IF(IMAT(I) .GT. 0) THEN 
            IESKP(I)=0 
          ENDIF 
    5   CONTINUE 
        XP=CORD(NODSH,1) 
        YP=CORD(NODSH,2) 
        XMIN=XP-5.0*PSCALE 
        YMIN=YP-3.5*PSCALE 
!ipk nov97 add (1)                                                      
        CALL PLOTOT(1) 
        FPN=NODSH 
        HT=0.15 
        XP=CORD(NODSH,1) 
        YP=CORD(NODSH,2) 
        CALL RCYAN 
        CALL NUMBR(XP,YP+0.07,HT,FPN,0.0,-1) 
        CALL RBLUE 
!                                                                       
        GO TO 2 
      ELSEIF(ANS .EQ. 'g') THEN 
!                                                                       
!  This option generates nodes on a line                                
!                                                                       
        CALL GNODE(1) 
        IF(IRMAIN .EQ. 1) RETURN 
        GO TO 2 
      ELSEIF(ANS .EQ. 'h') THEN 
        CALL HELPS(3) 
        IF(IRMAIN .EQ. 1) RETURN 
        GO TO 2 
      ELSE 
        GO TO 3 
      ENDIF 
    6 CONTINUE 
!                                                                       
!  Test for adding operation                                            
!                                                                       
      IF(ISWT .EQ. 1) THEN 
!                                                                       
        CALL GETNOD(J) 
        CALL GETNOD(J) 
        CALL GETNOD(J) 
        IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
!   Get number of node nearest cursor  (if ISWT = 0)                    
!                                                                       
      ELSE 
   61   IBOX=1 
!        CALL CLRBOX                                                    
        CALL HEDR 
!ipk jan98                                                              
        call wrtbox(idelv) 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
!ipk jan98  add option for deleting elevation on move                   
        IF(IBOX .EQ. 7  .or.  iflag .eq. 'e') THEN 
          IDELV=MOD(IDELV+1,2) 
          GO TO 61 
        ENDIF
        J=INODE 
!ipk jan98                                                              
        if(idelv .eq. 1) then 
          WD(J)=-9999. 
          WIDTH(J)=0. 
          SS1(J)=0. 
          SS2(J)=0. 
          WIDS(J)=0. 
          WIDBS(J)=0.
          SSO(J)=0.
        endif 
!ipk jan98                                                              
!                                                                       
        IF(IFLAG .EQ. 'q') THEN 
!ipk feb94          CALL WRTOUT(0)                                      
          GO TO 2 
        ENDIF 
        CALL PLTNOD(J,1) 
!                                                                       
      ENDIF 
!                                                                       
!   Deleting operation                                                  
!                                                                       
      IF(ISWT .EQ. 2) THEN 
        WRITE(NODH,5000) j 
!        CALL CLRBOX                                                    
        CALL HEDR 
        CALL SYMBL(0.,7.70,0.20,NODH,0.,20) 
        CALL DELETN(J) 
        GO TO 6 
      ENDIF 
      WRITE(NODH,5000) j 
 5000 FORMAT('Processing node',i5) 
    7 CALL CLRBOX 
      CALL SYMBL(0.,7.70,0.20,NODH,0.,20) 
      NHTP=0 
!      NMESS=0                                                          
      NBRR=3 
      IF(ISWT .EQ. 0) then 
        NMESS=16 
      endif 
      CALL HEDR 
!                                                                       
      IF (J .GE. MAXP)  THEN 
         CALL SETD(23) 
!IPK JAN98         WRITE(*,*) ' Node number exceeds MAXP '              
!IPK JAN98         WRITE(*,*) ' Enter -save- to save the file as is'    
!IPK JAN98         WRITE(*,*) ' Enter -quit- to terminate'              
!IPK JAN98         READ(*,'(A)') JUNK                                   
         CALL CLSCRN() 
         WRITE(LIND,*) ' Node number exceeds MAXP ' 
           call symbl                                                   &
     &     (1.1,4.6,0.25,LIND,0.0,80)                                   
         WRITE(LIND,*) ' Enter -save- to save the file as is' 
           call symbl                                                   &
     &     (1.1,4.1,0.25,LIND,0.0,80)                                   
         WRITE(LIND,*) ' Enter -quit- to terminate' 
           call symbl                                                   &
     &     (1.1,3.8,0.25,LIND,0.0,80)                                   
           ndig=4 
           CALL GTCHARX(JUNK,NDIG,5.0,4.0) 
         IF(JUNK .NE. 'save') THEN 
           CALL WRTOUT(0) 
           CALL Quit_Pgm() 
           stop 
         else 
           call wrtout(1) 
           CALL Quit_Pgm() 
           stop 
         ENDIF 
!ipk an97         RETURN                                                
      ENDIF 
!                                                                       
!  Get screen coordinate of node                                        
!                                                                       
      CALL XYLOC(XX,YY,IFLAG,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
      IF(IFLAG .EQ. 'q'  .OR.  (IFLAG .EQ. 'c'  .AND. IBOX .EQ. 10))THEN 
!ipk feb94          CALL WRTOUT(0)
!          IF(ISWT .EQ. 2) NP=NP-1
          if(inew(j) .eq. 0   .and.  j .eq. np) np=np-1
          GO TO 2 
      ENDIF 
!                                                                       
      IF (IFLAG .EQ. 'c')  THEN 
!                                                                       
         IF(YY .GT. 7.5) THEN 
           CALL DELETN(J) 
           GO TO 6 
         ENDIF 
         INSKP(J)=0 
         CORD(J,1) = XX 
         CORD(J,2) = YY 
         INEW(J) = 1 
!                                                                       
         XUSR(J) = XX*TXSCAL - XS 
         YUSR(J) = YY*TXSCAL - YS 
         IF (J .GT. NP)  NP = J 
!         WRITE(IOT,'(I10,2F10.3)')  J, XUSR(J),YUSR(J)                 
         CALL PLTNOD(J,0)
         ICHG=0 
!                                                                       
         IF(ISWT .EQ. 0) NMESS=17 
         GOTO 6 
      ENDIF 
      RETURN 
!                                                                       
      END                                           
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE ADDPTH 
!                                                                       
!  Add nodal bottom elevations                                          
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       
      CHARACTER*1  IFLAG,ANSW(10) 
      DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/ 
	  DATA NTYPP,NLOCC,BELEV/1,0,0./
!                                                                       
    4 CONTINUE 
      NHTP = 0 
      NMESS = 45
      NBRR = 0 
      CALL HEDR 
      xprt=3.2 
      NMESS = 14 
!                  
      CALL ADJUSTOPT(NTYPP,NLOCC)
                                                     
      CALL GETFPN(BELEV) 
!                                                                       
!  Write out current depths                                             
!                                                                       
    7 HT = .15 
      DO 10  J=1,NP 
        IF(INSKP(J) .EQ. 0) THEN 
         IF (CORD(J,1) .GT. VDX)  THEN 
!!SEP02            FPN = WD(J)*10. 
            FPN = WD(J)
            X = CORD(J,1) 
            Y = CORD(J,2) + .07 
            IF(X .GT. 0.  .AND.  X .LT. 10.0  .AND.                     &
     &         Y .GT. 0.  .AND.  Y .LT. 7.5) THEN                       
!!SEP02              CALL NUMBR(X,Y,HT,FPN,0.0,-1) 
            call numbr(x,y,0.12,fpn,0.0,1)
            ENDIF 
         ENDIF 
        ENDIF 
   10 END DO 
!                                                                       
!  Input new depths                                                     
!                                                                       
      NMESS = 15 
      NBRR = 4 
      CALL HEDR 
    5 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. 'q') THEN 
!ipk feb94          CALL WRTOUT(0)                                      
          RETURN 
      ELSEIF(IFLAG .EQ. 'e'  .OR.  IFLAG .EQ. 'n') THEN 
!ipk nov97 add (1)                                                      
        CALL PLOTOT(1) 
        GO TO 4 
      ENDIF 
      XPRT=XPRT+0.5 
      IF(XPRT .GT. 10.) XPRT=0. 
      FPN= INODE 
      CALL RRED 
      CALL NUMBR(XPRT,7.70,HT,FPN,0.0,-1) 
      IF (IFLAG .EQ. 'c')  THEN 
         IF(NTYPP .EQ. 1) THEN
           WD(INODE) = BELEV 
		 ELSE
		   WD(INODE) = WD(INODE)+BELEV
	     ENDIF
		 IF(NLOCC .EQ. 1) THEN
		   LOCK(INODE)=1
	     ENDIF
         ichg=0
         FPN = WD(INODE) 
         X = CORD(INODE,1) 
         Y = CORD(INODE,2) -0.10
         call numbr(x,y,0.12,fpn,0.0,1)
!!SEP02         CALL NUMBR(X,Y,HT,FPN,0.0,-1) 
         CALL RBLUE 
!                                                                       
      ELSEIF(IFLAG .EQ. 'a') THEN 
          CALL RRED
          ichg=0 
          DO 100 J=1,NP 
             IF (CORD(J,1) .GE. VDX)  THEN 
                WD(J)=BELEV 
                FPN=BELEV 
                X = CORD(J,1) 
                Y = CORD(J,2) + .11 
                CALL NUMBR(X,Y,HT,FPN,0.0,-1) 
             ENDIF 
  100     CONTINUE 
          CALL RBLUE 
          CALL WRTOUT(0) 
      ELSEIF(IFLAG .EQ. 'f') THEN 
          CALL RRED 
          DO 110 J=1,NP 
             IF (CORD(J,1) .GE. VDX  .AND. WD(J) .LT. -9000.)  THEN 
                WD(J)=BELEV 
                ichg=0
                FPN=BELEV 
                X = CORD(J,1) 
                Y = CORD(J,2) + .11 
                CALL NUMBR(X,Y,HT,FPN,0.0,-1) 
             ENDIF 
  110     CONTINUE 
          CALL RBLUE 
          CALL WRTOUT(0) 
!                                                                       
      ELSE 
!ipk jan98         WRITE(*,*)  CHAR(7),CHAR(7)                          
      ENDIF 
!                                                                       
      GOTO 5 
!                                                                       
      END                                           
!                                                                       
      SUBROUTINE JUNGEN(J,I,IERR) 
!                                                                       
!   Find elements coming into node J, change all but first node         
!   Form a new junction element                                         
!                                                                       
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

!IPK MAY02
      INCLUDE 'TXFRM.COM'

!                                                                       
      KOUNT=1 
      DO 200 N=1,NE 
!IPKOCT93        IF(IMAT(N) .GT. 0  .AND.  IMAT(N) .LT. 901) THEN       
        IF(IMAT(N) .GT. 0  .AND.  (IMAT(N) .LT. 901  .OR.               &
     &     IMAT(N) .GT. 903) ) THEN                                     
          DO 180 K=1,8 
            IF(NOP(N,K) .EQ. I) THEN 
              IF(K .GT. 3) THEN 
                IERR=1 
                RETURN 
              ENDIF 
              IF(KOUNT .EQ. 1) THEN 
                NOP(J,1)=I 
                IJUN(J)=1 
                KOUNT=2 
              ELSE 
                CALL GETNOD(N2) 
                NOP(J,KOUNT)=N2 
                IJUN(N2)=KOUNT 
                KOUNT=KOUNT+1 
                CORD(N2,1) = CORD(I,1) 
                CORD(N2,2) = CORD(I,2) 
                WD(N2)=WD(I) 
                WIDTH(N2) = WIDTH(I) 
                SS1(N2)=SS1(I) 
                SS2(N2)=SS2(I) 
                WIDS(N2)=WIDS(I) 
                INSKP(N2)=0 
                INEW(N2) = 1 
                NOP(N,K) = N2 
!                                                                       
                XUSR(N2) = CORD(N2,1)*TXSCAL - XS 
                YUSR(N2) = CORD(N2,2)*TXSCAL - YS 
                CALL PLTNOD(N2,1) 
                GO TO 200 
              ENDIF 
            ENDIF 
  180     CONTINUE 
        ENDIF 
  200 END DO 
      IF(KOUNT .LT. 9) THEN 
        DO 300 K=KOUNT,8 
          NOP(J,K)=0 
  300   CONTINUE 
      ENDIF 
      IMAT(J)=901 
      IESKP(J)=1 
      RETURN 
      END                                           
!                                                                       
!****************************************************************       
!                                                                       
      SUBROUTINE ELDAT 
!                                                                       
!  Add bottom elevations to message file and display                    
!                                                                       
      USE BLKMAP
      USE BLK1MOD
      USE WINTERACTER

      include 'd.inc'

!      INCLUDE 'BLK1.COM' 

!IPK MAY02
      INCLUDE 'TXFRM.COM'
!                                                                       
      CHARACTER*1  IFLAG,ANSW(10) 
      CHARACTER(LEN=256)  :: FILTER
      CHARACTER(LEN=255)  :: FNAME
      CHARACTER(LEN=3)    :: SUB
      LOGICAL            :: OPENED
      DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/ 
!
!ipk mar00
      jp=2
      DO 200 N=1,MAXLIN 
        IF(LINTYP(N) .EQ. -999) THEN 
          NLIN=N 
          GO TO 205 
        ENDIF 
  200 END DO 
  205 CONTINUE 
      IF(NLIN .GT. 1) THEN 
        IF(LINTYP(NLIN-1) .NE. 2) THEN 
          LINTYP(NLIN)=2 
        ELSE 
          NLIN=NLIN-1 
        ENDIF 
      ENDIF
      DO 250 J=MAXPL,1,-1 
        IF(CMAP(J,1) .GE. VDX) THEN 
          JP=J+1 
          GO TO 255 
        ENDIF 
  250 END DO 
  255 JP=JP-1 
      IPSW(6)=1 
!ipk nov97 add (1)                                                      
      CALL PLOTOT(1) 
      write(90,6010) 
 6010 format('  The lines that follow are locations and new bottom '    &
     &          ,'elevations.'/'  Note that a zoom operation may insert'&
     &          ,' other information')                                  
!                                                                       
    4 CONTINUE 
      NHTP = 0 
      NMESS = 45 
      NBRR = 0 
      CALL HEDR 
!                                                                       
      NMESS = 14 
      CALL GETFPN(BELEV) 
!                                                                       
!  Input new depths                                                     
!                                                                       
    7 CONTINUE 
      NMESS = 15 
      NBRR = 4 
      CALL HEDR 
!                                                                       
!  Get screen coordinates                                               
!                                                                       
      IBOX = 0 
      CALL XYLOC(XX,YY,IFLAG,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
      IF(IFLAG .EQ. 'c'  .AND. IBOX .GT. 0) THEN 
        IFLAG=ANSW(IBOX) 
      ENDIF 
      IF(IFLAG .EQ. 'q')THEN 
        RETURN 
      ENDIF 
      IF(IFLAG .EQ. 'e') THEN 
        RETURN 
      ENDIF 
      IF(IFLAG .EQ. 'n')THEN 
        GO TO 4 
      ENDIF 
!                                                                       
      IF (IFLAG .EQ. 'c')  THEN 
!                         
         JP=JP+1 
         CMAP(JP,1) = XX 
         CMAP(JP,2) = YY 
         VAL(JP)=BELEV 
!                                                                       
         XMAP(JP) = XX*TXSCAL - XS 
         YMAP(JP) = YY*TXSCAL - YS 
         IMAPOUT=27
         INQUIRE(27, OPENED=OPENED)
         if(.not. opened) then
           Filter='MAP file  -- *.map|*.map|'

           CALL WSelectFile(Filter,SaveDialog+PromptOn+AppendExt+DirChange,FNAME,'Save Map Data File')
 
           IF (WInfoDialog(ExitButtonCommon).EQ.CommonOpen) THEN

   	         CALL IlowerCase(FNAME)
	         CALL GETSUB(FNAME,SUB)
             OPEN(IMAPOUT,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
             WRITE(IMAPOUT,*) '2,0'
           ELSE
             GO TO 260
           ENDIF
         ENDIF
         WRITE(IMAPOUT,6000) XMAP(JP),YMAP(JP),VAL(JP) 
  260    CONTINUE
         WRITE(90,6000) XMAP(JP),YMAP(JP),VAL(JP) 
 6000    FORMAT(3F16.4) 
         FPN = BELEV 
         HT=0.15 
         CALL RRED 
         CALL NUMBR(XX,YY,HT,FPN,0.0,-1) 
!                                                                       
         GOTO 7 
!                                                                       
      ELSE 
!ipk jan98         WRITE(*,*)  CHAR(7),CHAR(7)                          
      ENDIF 
!                                                                       
      GOTO 7 
!                                                                       
      END                                           
!                                                                       
      SUBROUTINE DELOP 
!                                                                       
!  Input additional delete options from screen                          
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

!IPK MAY02
      INCLUDE 'TXFRM.COM'

      INCLUDE 'BFILES.I90'      

!                                                                       
      CHARACTER*1  IFLAG,ANS,ANSW(0:9) 
      CHARACTER*20 NODH 
      DATA ANSW/'l','m','g','u','f','j','h','z','r','q'/ 
!                                                                       
!  Draw box around selections                                           
!                                                                       
    2 CONTINUE 
      NHTP=10 
      NMESS=0 
      NBRR=0 
      CALL HEDR 
!                                                                       
!  Get answer                                                           
!                                                                       
    3 call xyloc(XPT,YPT,ANS,IBOX) 
      IF(IRMAIN .EQ. 1) RETURN 
!                                                                       
      IF(ANS .EQ. 'c') THEN
        if(ibox .eq. 0) go to 3 
        I=IBOX-1 
        ANS=ANSW(I) 
      ENDIF 
      IF(ANS .EQ. 'l') THEN 
!                                                                       
!     Delete all midside nodes                                          
!                                                                       
        CALL DELETM(0) 
      ELSEIF(ANS .EQ. 'm') THEN 
!                                                                       
!     Delete all center located midsides                                
!                                                                       
        CALL DELETM(1) 
      ELSEIF(ANS .EQ. 'g') THEN 
!                                                                       
!   Deleting operation for nodes                                        
!                                                                       
        NHTP=0 
        NBRR=3 
        NMESS=18 
                                                                        
    6   CONTINUE 
!                                                                       
        IBOX=1 
        CALL HEDR 
        CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
        IF(IRMAIN .EQ. 1) RETURN 
        J=INODE 
!                                                                       
        IF(IFLAG .EQ. 'q') THEN 
!ipk feb94          CALL WRTOUT(0)                                      
          GO TO 2 
        ENDIF 
        CALL PLTNOD(J,1) 
!                                                                       
        WRITE(NODH,5000) j 
 5000   FORMAT('Processing node',i5) 
        CALL HEDR 
        CALL SYMBL(0.,7.70,0.20,NODH,0.,20) 
        CALL DELETN(J) 
        IRDONE=0
        GO TO 6 
      ELSEIF(ANS .EQ. 'u') THEN 
!                                                                       
!     Delete all unused nodes                                           
!                                                                       
        CALL DELETM(2) 
      ELSEIF(ANS .EQ. 'j') THEN 
!                                                                       
!     Join two nodes together in the element lists                      
!                                                                       
        CALL JOIN(1) 
      ELSEIF(ANS .EQ. 'f') THEN 
!                                                                       
!     Fill midside nodes                                                
!                                                                       
!ipk aug02
        CALL FILM(0)
      ELSEIF(ANS .EQ. 'h') THEN 
        CALL HELPS(7) 
      ELSEIF(ANS .EQ. 'q') THEN 
        RETURN 
      ENDIF 
      GO TO 2 
      END                                           
!                                                                       
      SUBROUTINE JOIN(ISWTJ) 
!                                                                       
!     Routine to join references to two nodes                           
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
      CHARACTER*1  IFLAG 
!                                                                       
   61 IBOX=1 
      NHTP=0 
      NBRR=3 
      NMESS=15 
      CALL HEDR 
      CALL PROX(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,IFLAG,INSKP,IBOX) 
      IF(IFLAG .EQ. 'q') THEN 
        RETURN 
      ENDIF 
      FPN= INODE 
      CALL NUMBR(2.0,7.70,0.2,FPN,0.0,-1) 
!      CALL PROX(CORD(1,1),CORD(1,2),NP,XX2,YY2,INODE2,IFLAG,INSKP,IBOX)
!      IF(IFLAG .EQ. 'q') THEN                                          
!        RETURN                                                         
!      ELSEIF(INODE2 .EQ. INODE) THEN                                   
!                                                                       
!     Get second node                                                   
!                                                                       
        CALL PROX2(CORD(1,1),CORD(1,2),NP,XX,YY,INODE,                  &
     &           XX2,YY2,INODE2,IFLAG,INSKP,IBOX)                       
        IF(IFLAG .EQ. 'q') THEN 
          RETURN 
        ENDIF 
!      ENDIF                                                            
!        FPN= INODE2                                                    
!        CALL NUMBR(2.5,7.70,0.2,FPN,0.0,-1)                            

        INODE1=INODE
        CALL JOINDEL(INODE1,INODE2)

        CALL PLOTOT(1) 
        GO TO 61 
!      ENDIF                                                            
      END                                           

      SUBROUTINE JOINDEL(INODE1,INODE2)
!     Routine to join references to two nodes                           
!                                                                       
      USE BLK1MOD
!                                                                       
!     Search for references to INODE2                                   
!                                                                       
      DO N=1,NE 
         NCN=NCORN(N) 
          IF(NCN .GT. 0) THEN 
            DO M=1,NCN 
              IF(NOP(N,M) .EQ. INODE2) THEN 
!                                                                       
!     Change them to INODE                                              
!                                                                       
                NOP(N,M)=INODE1 
              ENDIF 
            ENDDO 
          ENDIF 
        ENDDO 
!                                                                       
!  Remove node now                                                      
!                                                                       
        CORD(INODE2,1)=VOID 
        CORD(INODE2,2)=VOID 
        XUSR(INODE2) = VOID 
        YUSR(INODE2) = VOID 
        INSKP(INODE2)=1 
        INEW(INODE2) = 0 
        WD(INODE2)=-9999. 
        WIDTH(INODE2)=0. 
        SS1(INODE2)=0. 
        SS2(INODE2)=0. 
        WIDS(INODE2)=0. 
!IPK MAY03                   
        ICHG=0
!ipk nov97 add (1)                     
        RETURN
      END

      SUBROUTINE JOINALL
      USE BLK1MOD

      NMESS = 46 
      TOLER=0.1                              
      CALL GETFPN(TOLER) 
      
      DO N=1,NP-1
        IF(CORD(N,1) .EQ. VOID) CYCLE
        DO M=N+1,NP
          IF(CORD(M,1) .EQ. VOID) CYCLE
          DIST=SQRT((YUSR(M)-YUSR(N))**2+(XUSR(M)-XUSR(N))**2)
          IF(DIST .LT. TOLER) THEN
            CALL JOINDEL(N,M)
            GO TO 100
          ENDIF
        ENDDO
  100   CONTINUE  
      ENDDO

      CALL PLOTOT(1) 
      RETURN
      END
!****************************************************************       
!                                                                       
      SUBROUTINE ADDPTH2(nodlist,ndlist) 
!                                                                       
!  Add nodal bottom elevations                                          
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 
!                                                                       
      CHARACTER*1  IFLAG,ANSW(10)

	  dimension nodlist(*)  

      DATA ANSW/' ',' ',' ',' ',' ',' ','n','z','r','q'/ 
	  DATA NTYPP,NLOCC/1,0/
!                                                                       
    4 CONTINUE 
      NHTP = 0 
      NMESS = 45
      NBRR = 0 
      CALL HEDR 
      xprt=3.2 
      NMESS = 14 
!                  
      CALL ADJUSTOPT(NTYPP,NLOCC)
                                                     
      CALL GETFPN(BELEV) 
!                                                                       
!  Write out current depths                                             
!                                                                       
    7 HT = .15 
      DO 10  J=1,NP 
        IF(INSKP(J) .EQ. 0) THEN 
         IF (CORD(J,1) .GT. VDX)  THEN 
!!SEP02            FPN = WD(J)*10. 
            FPN = WD(J)
            X = CORD(J,1) 
            Y = CORD(J,2) + .07 
            IF(X .GT. 0.  .AND.  X .LT. HSIZE  .AND.                     &
     &         Y .GT. 0.  .AND.  Y .LT. 7.5) THEN                       
!!SEP02              CALL NUMBR(X,Y,HT,FPN,0.0,-1) 
            call numbr(x,y,0.12,fpn,0.0,1)
            ENDIF 
         ENDIF 
        ENDIF 
   10 END DO 
!                                                                       
!  Input new depths                                                     
!                                                                       
      DO J=1,NDLIST
	    INODE=NODLIST(J)
        FPN= INODE 
        CALL RRED 

        IF(NTYPP .EQ. 1) THEN
          WD(INODE) = BELEV 
   	    ELSE
	      WD(INODE) = WD(INODE)+BELEV
	    ENDIF
	    IF(NLOCC .EQ. 1) THEN
		  LOCK(INODE)=1
	    ENDIF
        ichg=0
        FPN = WD(INODE) 
        X = CORD(INODE,1) 
        Y = CORD(INODE,2) -0.10
        call numbr(x,y,0.12,fpn,0.0,1)
!!SEP02         CALL NUMBR(X,Y,HT,FPN,0.0,-1) 
        CALL RBLUE 
      ENDDO
!                                                                       
!                                                                       
      RETURN
!                                                                       
    END                                           
!                                                                       
    SUBROUTINE FINDNOD
!                                                                       
!  Search for a plot a grid centered around a node                      
!                                                                       
!                                                                       
      USE BLK1MOD
!      INCLUDE 'BLK1.COM' 

!IPK MAY02
      INCLUDE 'TXFRM.COM'
!                                                                       
      NHTPSAV=NHTP 
      NMESSAV=NMESS
      NBRRSAV=NBRR 
        NHTP=0 
        NBRR=0 
        NMESS=1
        CALL HEDR 
        NMESS=1 
        CALL GETINT(NODSH) 
        IF(INEW(NODSH) .LE. 0) RETURN
        DO 4 I=1,NP 
          IF(CORD(I,1) .GT. VOID) THEN 
            INSKP(I)=0 
          ENDIF 
    4   CONTINUE 
        DO 5 I=1,NE 
          IF(IMAT(I) .GT. 0) THEN 
            IESKP(I)=0 
          ENDIF 
    5   CONTINUE 
        XP=CORD(NODSH,1) 
        YP=CORD(NODSH,2) 
        XMIN=XP-5.0*PSCALE 
        YMIN=YP-3.5*PSCALE 
!ipk nov97 add (1)                                                      
        CALL PLOTOT(1) 
        FPN=NODSH 
        HT=0.15 
        XP=CORD(NODSH,1) 
        YP=CORD(NODSH,2) 
        CALL RCYAN 
        CALL NUMBR(XP,YP+0.07,HT,FPN,0.0,-1) 
        CALL RBLUE
        NHTP=NHTPSAV 
        NMESS=NMESSAV
        NBRR=NBRRSAV 
        CALL HEDR
!                                                                       
        RETURN
        END