SUBROUTINE RESETWHGT
      USE BLK1MOD
      USE BLK2MOD
      INCLUDE 'TXFRM.COM'
      SAVE
      DIST(N,M)=Sqrt((cord(n,1)-cord(m,1))**2+(cord(n,2)-cord(m,2))**2)*txscal
!      INCLUDE 'BLK1A.COM'
!      DIMENSION K1(50000),levrem(50000)
!      ALLOCATABLE NRF(:),AREF(:),LEVREM(:),TRANSEL(:),WLEN(:),WHGT(:),TRCEL(:)
      IF(.NOT.  ALLOCATED (NRF)) THEN
        ALLOCATE (NRF(MAXP),AREF(MAXP),LEVREM(MAXP))
      ENDIF
      IF(.NOT.  ALLOCATED (TRANSEL)) THEN
        ALLOCATE(TRANSEL(MAXP),WLEN(MAXP),WHGT(MAXP))
      ENDIF
      NRF=0
      AREF=0
      K1=0
      levrem=0
      WHGT=-9999.
      ISWW=1
      CALL KCON(ISWW)
      CALL PANELWHT(IWTYP,ISWL,R1,R2)
      IF(IWTYP .LE. 0) RETURN
      IF(ISWL .EQ. 2) GO TO 300
      DO N=1,NE
        IF(IMAT(N) .EQ. IWTYP) THEN
          DO K=2,6,4
            KK=NOP(N,K)
            DO M=1,NE
              IF(IMAT(M) .EQ. IWTYP) CYCLE
              DO L=2,NCORN(M),2
                IF(NOP(M,L) .EQ. KK) THEN
                  IF(NCORN(M) .EQ. 8)  THEN
                    IF(L .EQ. 2) THEN
                      IOP1=NOP(M,5)
                      IOP2=NOP(M,7)
                    ELSEIF(L .EQ. 4) THEN
                      IOP1=NOP(M,7)
                      IOP2=NOP(M,1)
                    ELSEIF(L .EQ. 6) THEN
                      IOP1=NOP(M,1)
                      IOP2=NOP(M,3)
                    ELSEIF(L .EQ. 8) THEN
                      IOP1=NOP(M,3)
                      IOP2=NOP(M,5)
                    ENDIF

                  ELSE
                    IF(L .EQ. 2) THEN
                      IOP1=NOP(M,5)
                      IOP2=NOP(M,5)
                    ELSEIF(L .EQ. 4) THEN
                      IOP1=NOP(M,1)
                      IOP2=NOP(M,1)
                    ELSE
                      IOP1=NOP(M,3)
                      IOP2=NOP(M,3)
                    ENDIF
                  ENDIF
                  IF(NRF(NOP(N,K-1)) .EQ. 0) THEN
                    NRF(NOP(N,K-1))=IOP1
                    AREF(NOP(N,K-1))=WD(IOP1)
                  ELSEIF(WD(IOP1) .GT. WD(NOP(N,K-1))) THEN
                    NRF(NOP(N,K-1))=IOP1
                    AREF(NOP(N,K-1))=WD(IOP1)
                  ENDIF                        
                  IF(NRF(NOP(N,K+1)) .EQ. 0) THEN
                    NRF(NOP(N,K+1))=IOP2
                    AREF(NOP(N,K+1))=WD(IOP2)
                  ELSEIF(WD(IOP2) .GT. WD(NOP(N,K+1))) THEN
                    NRF(NOP(N,K+1))=IOP2
                    AREF(NOP(N,K+1))=WD(IOP2)
                  ENDIF
                ENDIF
              ENDDO
            ENDDO
          ENDDO
        ENDIF
      ENDDO
      DO N=1,NE
        IF(IMAT(N) .EQ. IWTYP) THEN
          DO K=1,7,2
            IF(AREF(NOP(N,K)) .GE. WD(NOP(N,K))-0.1) THEN
              IMAT(N)=IWTYP
              nnn=nop(n,k)
              write(151,*) 'levee reset',n,k,nnn,aref(nnn),WD(nnn)
              do kk=1,7,2
                levrem(nop(n,kk))=1
              enddo
              GO TO 150
            ELSEIF(NRF(NOP(N,K)) .EQ. 0) THEN
              IMAT(N)=99
              nnn=nop(n,k)
              write(151,*) 'Levee element removed',n,k,nnn
              GO TO 150
            ELSE
              WRITE(151,*) 'Levee active', n,aref(nop(n,k)),iop1
              IMAT(N)=IWTYP+900
            ENDIF
          ENDDO
        ENDIF
  150   CONTINUE      
      ENDDO
      IF(IWTP .LT. 900) IWTYP=IWTYP+900
      DO N=1,NE
        IF(IMAT(N) .EQ. IWTYP) THEN
          KCT=1
          NPK1=NOP(N,1)
          NPK2=NOP(N,3)
  160     CONTINUE            
          IF(levrem(NPK1) .eq. 1) then
            if(levrem(npk2) .eq. 1) then
              IMAT(N)=IWTYP-900
              GO TO 180
            else
              IF(KCT .EQ. 1) THEN
                MA=NECON(NOP(N,4),1)
                MB=NECON(NOP(N,4),2)
              ELSE
                MA=NECON(NOP(N,8),1)
                MB=NECON(NOP(N,8),2)
              ENDIF
              IF(MA .EQ. N) MA=MB
              IF(MA .NE. 0) THEN
                IF(NOP(MA,1) .EQ. NPK2) THEN
                  IF(LEVREM(NOP(MA,3)) .EQ. 1) THEN
                    IMAT(N)=IWTYP-900
                    IMAT(MA)=IWTYP-900
                  ENDIF  
                ELSEIF(NOP(MA,3) .EQ. NPK2) THEN
                  IF(LEVREM(NOP(MA,1)) .EQ. 1) THEN
                    IMAT(N)=IWTYP-900
                    IMAT(MA)=IWTYP-900
                  ENDIF
                ENDIF
              ENDIF  
            endif
          ENDIF
          NPK2=NOP(N,1)
          NPK1=NOP(N,3)
          IF(KCT .EQ. 1) THEN
            KCT=2
            GO TO 160
          ENDIF
        ENDIF        
  180   CONTINUE      
      ENDDO
      DO N=1,NE
        IF(IMAT(N) .EQ. IWTYP) THEN
          DO K=1,7,2
            IOP1=NRF(NOP(N,K))
            IF(IOP1 .GT. 0) THEN
              NPK=NOP(N,K)
              WHGT(NPK)=WD(NPK)
              TRANSEL(NPK)=WHGT(NPK)+R1
              n1=nop(n,k)
              n2=nop(n,8-k)
              wlen(NPK)=dist(n1,n2)
              NRF(NPK)=-NRF(NPK)
              if(levrem(NPK) .eq. 0) then
                WD(NPK)=WD(IOP1)
                TRANSEL(NPK)=WHGT(NPK)+R1
                n1=nop(n,k)
                n2=nop(n,8-k)
                wlen(NPK)=dist(n1,n2)
!                wlen(NPK)=8.
              endif
            ENDIF
          ENDDO
  200     CONTINUE  
!          AMMN=(WHGT(NOP(N,1))+WHGT(NOP(N,3)))/2.
!          IF(AMMN .GT. WHGT(NOP(N,1))) THEN
!            TRCEL(N)=AMMN - WHGT(NOP(N,1))+0.1
!          ELSE
!            TRCEL(N)=AMMN - WHGT(NOP(N,3))+0.1
!          ENDIF
!          TRCEL(N)=0.25
!          write(151,*) 'levee element trc set',n,trcel(n),whgt(nop(n,1))&
!       ,whgt(nop(n,3))   
        ENDIF
      ENDDO
      DEALLOCATE (NRF,AREF,LEVREM)
      GO TO 400
  300 CONTINUE      
      DO N=1,NE
        IF(IMAT(N) .EQ. IWTYP) THEN
          DO K=1,7,2
            NPK=NOP(N,K)
            WHGT(NPK)=WD(NPK)+R2
            TRANSEL(NPK)=WHGT(NPK)+R1
            n1=nop(n,k)
            n2=nop(n,8-k)
            wlen(NPK)=dist(n1,n2)
          ENDDO
        ENDIF
      ENDDO
  400 call OUTWDT
      RETURN
      END

      SUBROUTINE PANELWHT(N1,ISWL,R1,R2)

      use winteracter

      implicit none

      include 'D.inc'
      INCLUDE 'BFILES.I90'

!
! Declare window-type and message variables
!
      TYPE(WIN_STYLE)    :: WINDOW

      TYPE(WIN_MESSAGE) :: MESSAGE

      integer  :: N1,IERR,ISWL
      real     :: R1,R2
      character*3 :: sub

      call wdialogload(IDD_SETWRS)
      ierr=infoerror(1)

      call wdialogputRadioButton(idf_radio1)      
      CALL WDialogPutInteger(idf_integer1,n1)
      CALL WDialogPutReal(idf_real1,r1)
      CALL WDialogPutReal(idf_real2,r2)


      CALL WDialogSelect(IDD_SETWRS)
      ierr=infoerror(1)

      CALL WDialogShow(-1,-1,0,Modal)
      ierr=infoerror(1)
      
      IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
        call wdialoggetradiobutton(idf_radio1,ISWL)
        CALL WDialogGetInteger(idf_integer1,n1)
        CALL WDialogGetReal(idf_real1,r1)
        CALL WDialogGetReal(idf_real2,r2)
      ELSEIF (WInfoDialog(ExitButton) .EQ. IDCANCEL) THEN
        N1=-1
      
      ENDIF
      RETURN
      END
       
      SUBROUTINE OUTWDT

	  USE WINTERACTER 
      USE BLK1MOD
      INCLUDE 'TXFRM.COM'

      CHARACTER(LEN=255)  :: FNAME,FILTER
      CHARACTER(LEN=4)    :: SUB
	  LOGICAL OPENED
      CHARACTER*1  IFLAG,ANS(10)

      IOUTWR=81
      INQUIRE(81, OPENED=OPENED)
      if(.not. opened) then
        Filter='WDT file  -- *.dat|*.dat|'

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

   	      CALL IlowerCase(FNAME)
	      CALL GETSUB(FNAME,SUB)
          OPEN(IOUTWR,FILE=FNAME,STATUS='UNKNOWN',ACTION='WRITE')
          GO TO 3
        ELSE
          GO TO 1
        ENDIF
      ELSE
        REWIND(IOUTWR)
        GO TO 3
      ENDIF

1     RETURN

3     DO N=1,NP
        IF(WHGT(N) .GT. -9999.) THEN
          WRITE(IOUTWR,7778) N,WHGT(N),WLEN(N),TRANSEL(N)
7778      FORMAT('WDT',5X,I8,3F8.2)
        ENDIF
      ENDDO
      CLOSE(IOUTWR)
      
      RETURN
      END