SUB_UNITHYDRO/Fortran/SUB_UNITHYDRO.f90
2025-04-18 11:16:17 +08:00

114 lines
3.5 KiB
Fortran

!根据流域经验单位线和实测的降雨量,推求净雨过程和洪水过程线
SUBROUTINE SUB_UNITHYDRO(S,& !流域面积 浮点数,输入
QT,& !暴雨过程降雨量 浮点数,输入
M,& !暴雨过程时段数 整数,输入
Q,& !该流域典型单位线 浮点数,输入
N,& !单位线时段数 整数,输入
IM,& !最大蓄水量 浮点数,输入
FC,& !稳定下渗率 浮点数,输入
QF,& !基流 浮点数,输入
T,& !每时段的时长 浮点数,输入
A,& !地下与地面径流历时的比值 浮点数,输入
RUNOFF_U,& !地面径流过程线 浮点数,输出
RUNOFF_G,& !地下径流过程线 浮点数,输出
RUNOFF)& !总的洪水过程线 浮点数,输出
bind(C, name="SUB_UNITHYDRO")
!DEC$ ATTRIBUTES DLLEXPORT::SUB_UNITHYDRO
integer :: m,n
real :: S,Qt(m),q(n),Im,fc,Qf,t,a
real :: Qsum(m),Qj_sum(m),Qj_t(m),Qj_g(m),Qj_u(m)
real :: runoff_ut(100,100),runoff_u(100),runoff_g(100),RUNOFF(100)
integer :: x,y
real :: Wg,Tg,Qmg
real :: Pa !前期影响雨量
real :: Qj_eu(100) !把地面净雨量大于0的单独存入
real :: Qj_gs=0 !地下净雨总量
integer :: i,j !计数器
!************** 净雨计算及净雨的分割 **************
!计算累计降雨量
Qsum(1)=Qt(1)
do i=2,m
Qsum(i)=Qsum(i-1)+Qt(i)
end do
!计算各净雨量
Pa=Im*2/3
do i=1,m
if(Qsum(i)<=(Im-Pa)) then
Qj_t(i)=0
Qj_g(i)=0
else
Qj_t(i)=Qsum(i)-(Im-Pa)
Qj_g(i)=(Qj_t(i)/Qt(i))*t*fc
exit
end if
end do
do while(i<m)
Qj_t(i+1)=Qt(i+1) !时段净雨量
Qj_g(i+1)=t*fc
if(Qj_g(i+1)>Qt(i+1)) Qj_g(i+1)=Qt(i+1) !地下净雨量
i=i+1
end do
Qj_sum(1)=Qj_t(1)
Qj_u(1)=Qj_t(1)-Qj_g(1)
do i=2,m
Qj_sum(i)=Qj_sum(i-1)+Qj_t(i) !累计净雨量
Qj_u(i)=Qj_t(i)-Qj_g(i) !地面净雨量
end do
!******************** 推求洪水过程线 **************************
!计算地面径流过程*************************************
x=0
do i=1,m
if(Qj_u(i)/=0) then
x=x+1
Qj_eu(x)=Qj_u(i)
end if
end do
runoff_ut=0
runoff_u=0
y=n+x
!单位线法计算各时段地面径流过程
do i=1,n
do j=1,x
runoff_ut(j,i+j-1)=q(i)*Qj_eu(j)/10.0
end do
end do
!计算地面径流过程线
do i=1,y
do j=1,x
runoff_u(i)=runoff_u(i)+runoff_ut(j,i)
end do
end do
!计算地下径流过程*********************************
runoff_g(1)=0
do i=1,m
Qj_gs=Qj_gs+Qj_g(i)
end do
Wg=1000*Qj_gs*S
Tg=a*(y-2)*t
Qmg=2*Wg/(Tg*3600)
do i=2,y
runoff_g(i)=runoff_g(i-1)+Qmg/(a*(y-2)/2)
if(i>(a*(y-2)/2+1)) runoff_g(i)=runoff_g(i-1)-Qmg/(a*(y-2)/2)
end do
!计算总的洪水过程线*********************************
do i=1,y
RUNOFF(i)=runoff_u(i)+runoff_g(i)+Qf
end do
end subroutine