You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
136 lines
3.4 KiB
Fortran
136 lines
3.4 KiB
Fortran
5 years ago
|
SUBROUTINE ADDSLOT
|
||
|
|
|
||
|
|
! ADD SLOT TO 1-D
|
||
|
|
|
||
|
|
USE BLK1MOD
|
||
|
|
|
||
|
|
! GET SLOT PARAMETERS
|
||
|
|
|
||
|
|
CALL GETSLOTPARAM(ISLTYP,SLDEP,SLRNG,SLPOR)
|
||
|
|
IF(ISLTYP .EQ. -1) RETURN
|
||
|
|
|
||
|
|
! SEARCH FOR CROSS-SECTION REACH/TYPE
|
||
|
|
IF(ISLTYP .EQ. 0) THEN
|
||
|
|
DO N=1,MCRS
|
||
|
|
IF(IVMIL(N) .LT. 1) EXIT
|
||
|
|
MM=NRIVL(IVMIL(N))
|
||
|
|
IF(MM .GT. 0) THEN
|
||
|
|
CALL ADDSLOTDATA(IVMIL(N),MM,SLDEP,SLRNG,SLPOR)
|
||
|
|
ENDIF
|
||
|
|
NRIVL(IVMIL(N))=MM
|
||
|
|
ENDDO
|
||
|
|
ELSE
|
||
|
|
! SEARCH FOR CROSS-SECTION REACH/TYPE
|
||
|
|
!
|
||
|
|
! IVMIL = CROSS-SECTION NUMBER
|
||
|
|
! NRIVL = NUMBER OF POINTS IN SECTION
|
||
|
|
! NOREACH = REACH/TYPE NUMBER
|
||
|
|
! CRSDAT 1 = ELEVATION
|
||
|
|
! CRSDAT 2 = AREA
|
||
|
|
! CRSDAT 3 = WIDTH
|
||
|
|
|
||
|
|
DO N=1,MCRS
|
||
|
|
IF(ISLTYP .EQ. NOREACH(N)) THEN
|
||
|
|
MM=NRIVL(IVMIL(N))
|
||
|
|
CALL ADDSLOTDATA(IVMIL(N),MM,SLDEP,SLRNG,SLPOR)
|
||
|
|
NRIVL(IVMIL(N))=MM
|
||
|
|
ENDIF
|
||
|
|
ENDDO
|
||
|
|
ENDIF
|
||
|
|
! APPLY CHANGE
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
|
||
|
|
SUBROUTINE GETSLOTPARAM(ISLTYP,SLDEP,SLRNG,SLPOR)
|
||
|
|
use winteracter
|
||
|
|
USE BLK1MOD
|
||
|
|
|
||
|
|
!-
|
||
|
|
|
||
|
|
include 'd.inc'
|
||
|
|
|
||
|
|
!
|
||
|
|
! Declare window-type and message variables
|
||
|
|
!
|
||
|
|
TYPE(WIN_STYLE) :: WINDOW
|
||
|
|
|
||
|
|
TYPE(WIN_MESSAGE) :: MESSAGE
|
||
|
|
INTEGER :: IERR,ISET,IBOX
|
||
|
|
REAL :: ASET
|
||
|
|
CHARACTER*1 :: IFLAG
|
||
|
|
|
||
|
|
call wdialogload(IDD_ADDSLOT)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
CALL WDialogSelect(IDD_ADDSLOT)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
ISLTYP=0
|
||
|
|
SLDEP=4.
|
||
|
|
SLRNG=0.5
|
||
|
|
SLPOR=0.1
|
||
|
|
100 continue
|
||
|
|
|
||
|
|
|
||
|
|
CALL WDialogPutINTEGER(IDF_INTEGER1,ISLTYP)
|
||
|
|
CALL WDialogPutReal(idf_real1,SLDEP)
|
||
|
|
CALL WDialogPutReal(idf_real2,SLRNG)
|
||
|
|
CALL WDialogPutReal(idf_real3,SLPOR)
|
||
|
|
|
||
|
|
CALL WDialogShow(-1,-1,0,Modal)
|
||
|
|
ierr=infoerror(1)
|
||
|
|
|
||
|
|
DO
|
||
|
|
!
|
||
|
|
IF (WInfoDialog(ExitButton) .EQ. IDOK) THEN
|
||
|
|
|
||
|
|
|
||
|
|
CALL WDialogGetINTEGER(IDF_INTEGER1,ISLTYP)
|
||
|
|
CALL WDialogGetReal(idf_real1,SLDEP)
|
||
|
|
CALL WDialogGetReal(idf_real2,SLRNG)
|
||
|
|
CALL WDialogGetReal(idf_real3,SLPOR)
|
||
|
|
GO TO 200
|
||
|
|
else
|
||
|
|
ISLTYP=-1
|
||
|
|
RETURN
|
||
|
|
endif
|
||
|
|
ENDDO
|
||
|
|
200 CONTINUE
|
||
|
|
RETURN
|
||
|
|
END
|
||
|
|
SUBROUTINE ADDSLOTDATA(N,M,SLDEP,SLRNG,SLPOR)
|
||
|
|
USE BLK1MOD
|
||
|
|
BLEVL=CRSDAT(N,1,1)
|
||
|
|
BWIDT=CRSDAT(N,1,3)
|
||
|
|
IF(BWIDT .LT. 1) THEN
|
||
|
|
CRSDAT(N,1,3)=1.0
|
||
|
|
CRSDAT(N,0,1)=BLEVL-SLRNG
|
||
|
|
CRSDAT(N,0,3)=SLPOR
|
||
|
|
CRSDAT(N,-1,1)=CRSDAT(N,0,1)-SLDEP
|
||
|
|
CRSDAT(N,-1,3)=SLPOR
|
||
|
|
MLT=-1
|
||
|
|
ELSE
|
||
|
|
CRSDAT(N,0,1)=BLEVL-SLRNG
|
||
|
|
CRSDAT(N,0,3)=1.0
|
||
|
|
CRSDAT(N,-1,1)=BLEVL-2.*SLRNG
|
||
|
|
CRSDAT(N,-1,3)=SLPOR
|
||
|
|
CRSDAT(N,-2,1)=CRSDAT(N,0,1)-SLDEP
|
||
|
|
CRSDAT(N,-2,3)=SLPOR
|
||
|
|
MLT=-2
|
||
|
|
ENDIF
|
||
|
|
DO I=M,MLT,-1
|
||
|
|
DO J=1,3
|
||
|
|
CRSDAT(N,I+1-MLT,J)=CRSDAT(N,I,J)
|
||
|
|
ENDDO
|
||
|
|
ENDDO
|
||
|
|
M=M+1-MLT
|
||
|
|
DO I=2,M
|
||
|
|
if(i .gt. 1) then
|
||
|
|
CRSDAT(N,I,2)=CRSDAT(N,I-1,2)+&
|
||
|
|
(CRSDAT(N,I,1)-CRSDAT(N,I-1,1))*&
|
||
|
|
(CRSDAT(N,I,3)+CRSDAT(N,I-1,3))/2.
|
||
|
|
endif
|
||
|
|
ENDDO
|
||
|
|
RETURN
|
||
|
|
END
|