misaki/SUB_UNITHYDRO
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
0389e4002f
SUB_UNITHYDRO/Fortran/SUB_UNITHYDRO.f90

114 lines
3.5 KiB
Fortran
Raw Normal View History

3
2025-04-18 11:00:47 +08:00
!<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>鵥λ<E9B5A5>ߺ<EFBFBD>ʵ<EFBFBD><CAB5><EFBFBD>Ľ<EFBFBD><C4BD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>̺ͺ<CCBA>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
SUBROUTINE SUB_UNITHYDRO(S,& !<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
QT,& !<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>̽<EFBFBD><CCBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
M,& !<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD><CAB1><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Q,& !<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>͵<EFBFBD>λ<EFBFBD><CEBB> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
N,& !<21><>λ<EFBFBD><CEBB>ʱ<EFBFBD><CAB1><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
IM,& !<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FC,& !<21>ȶ<EFBFBD><C8B6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
QF,& !<21><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
T,& !ÿʱ<C3BF>ε<EFBFBD>ʱ<EFBFBD><CAB1> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
A,& !<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>澶<EFBFBD><E6BEB6><EFBFBD><EFBFBD>ʱ<EFBFBD>ı<EFBFBD>ֵ <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
RUNOFF_U,& !<21><><EFBFBD>澶<EFBFBD><E6BEB6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
RUNOFF_G,& !<21><><EFBFBD>¾<EFBFBD><C2BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
RUNOFF)& !<21>ܵĺ<DCB5>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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),W(100)
integer :: x,y
real :: Wg,Tg,Qmg
real :: Pa !ǰ<><C7B0>Ӱ<EFBFBD><D3B0><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
real :: Qj_eu(100) !<21>ѵ<EFBFBD><D1B5>澻<EFBFBD><E6BEBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>0<EFBFBD>ĵ<EFBFBD><C4B5><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
real :: Qj_gs=0 !<21><><EFBFBD>¾<EFBFBD><C2BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
integer :: i,j !<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
!************** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>㼰<EFBFBD><E3BCB0><EFBFBD><EFBFBD><EFBFBD>ķָ<C4B7> **************
!<21><><EFBFBD><EFBFBD><EFBFBD>ۼƽ<DBBC><C6BD><EFBFBD><EFBFBD><EFBFBD>
Qsum(1)=Qt(1)
do i=2,m
Qsum(i)=Qsum(i-1)+Qt(i)
end do
!<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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) !ʱ<>ξ<EFBFBD><CEBE><EFBFBD><EFBFBD><EFBFBD>
Qj_g(i+1)=t*fc
if(Qj_g(i+1)>Qt(i+1)) Qj_g(i+1)=Qt(i+1) !<21><><EFBFBD>¾<EFBFBD><C2BE><EFBFBD><EFBFBD><EFBFBD>
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) !<21>ۼƾ<DBBC><C6BE><EFBFBD><EFBFBD><EFBFBD>
Qj_u(i)=Qj_t(i)-Qj_g(i) !<21><><EFBFBD>澻<EFBFBD><E6BEBB><EFBFBD><EFBFBD>
end do
!******************** <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD> **************************
!<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>澶<EFBFBD><E6BEB6><EFBFBD><EFBFBD><EFBFBD><EFBFBD>*************************************
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
!<21><>λ<EFBFBD>߷<EFBFBD><DFB7><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ʱ<EFBFBD>ε<EFBFBD><CEB5>澶<EFBFBD><E6BEB6><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
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
!<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>澶<EFBFBD><E6BEB6><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
do i=1,y
do j=1,x
runoff_u(i)=runoff_u(i)+runoff_ut(j,i)
end do
end do
!<21><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>¾<EFBFBD><C2BE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>*********************************
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
!<21><><EFBFBD><EFBFBD><EFBFBD>ܵĺ<DCB5>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD>*********************************
do i=1,y
W(i)=runoff_u(i)+runoff_g(i)+Qf
end do
end subroutine
Reference in New Issue Copy Permalink