zzx/XAJMX
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

更新 Fortran/SUB_XAJMX.f90

Browse Source
This commit is contained in:
zzx 2025-05-09 13:45:09 +08:00
parent 7835711048
commit 6c7785fc6c
1 changed files with 60 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
Fortran/SUB_XAJMX.f90
View File

@ -1,60 +1,60 @@
SUBROUTINE SUB_XAJMX( N ,& ! 单元出流数组大小 //输入变量
M ,& ! 无因次单位数组大小 //输入变量
PAR ,& ! //输入变量
AREA ,& ! 单元面积 //输入变量
UH ,& ! 无因次单位线 //输入变量
DT ,& ! 时段步长 //输入变量
P ,& ! 降雨系列 //输入变量
EP ,& ! 蒸发皿蒸发能力 //输入变量
W ,& ! 土壤含水层 1.上层 2.下层 3.深层 //输入变量
FR ,& ! 初始产流面积 //输入变量
S ,& ! 初始自由水深 //输入变量
QRSS0 ,& ! 初始壤中流流量 //输入变量
QRG0 ,& ! 初始地下水径流量 //输入变量
QR ) ! 单元出流 //输出变量
SUBROUTINE SUB_XAJMX( N ,& ! 单元出流数组大小 //输入变量
M ,& ! 无因次单位数组大小 //输入变量
PAR ,& ! //输入变量
AREA ,& ! 单元面积 //输入变量
UH ,& ! 无因次单位线 //输入变量
DT ,& ! 时段步长 //输入变量
P ,& ! 降雨系列 //输入变量
EP ,& ! 蒸发皿蒸发能力 //输入变量
W ,& ! 土壤含水层 1.上层 2.下层 3.深层 //输入变量
FR ,& ! 初始产流面积 //输入变量
S ,& ! 初始自由水深 //输入变量
QRSS0 ,& ! 初始壤中流流量 //输入变量
QRG0 ,& ! 初始地下水径流量 //输入变量
QR ) ! 单元出流 //输出变量
IMPLICIT NONE
!///////////////////////////////////////变量声明//////////////////////////////////////////////
!///////////////////////////////////////变量声明//////////////////////////////////////////////
INTEGER::N !
INTEGER::M !
REAL::PAR(13) ! 1.上层张力水容量wum 2.下层张力水容量wl 3.深层张力水容量wdm
! 4.蒸发能力折算系数KC.深层蒸发系数c 6.张力水蓄水容量系数b
! 7.不透水面积比率imp1 8.自由水蓄水容量sm 9.自由水蓄水容量指数ex
!10.地下水出流系数kg 11.壤中流出流系数kss 12.地下水出流系数kkg
!13.壤中流出流系数kkss
REAL::AREA ! 单元面积
REAL::UH(M) ! 无因次单位线
REAL::DT ! 时段步长
REAL::P(N) ! 降雨系列
REAL::EP(N) ! 蒸发皿蒸发能力
REAL::QR(N) ! 单元出流
REAL::W(3) ! 土壤含水层 1.上层 2.下层 3.深层
REAL::FR ! 初始产流面积
REAL::S ! 初始自由水深
REAL::QRSS0 ! 初始壤中流流量
REAL::QRG0 ! 初始地下水径流量
REAL::PAR(13) ! 1.上层张力水容量wum 2.下层张力水容量wl 3.深层张力水容量wdm
! 4.蒸发能力折算系数KC.深层蒸发系数c 6.张力水蓄水容量系数b
! 7.不透水面积比率imp1 8.自由水蓄水容量sm 9.自由水蓄水容量指数ex
!10.地下水出流系数kg 11.壤中流出流系数kss 12.地下水出流系数kkg
!13.壤中流出流系数kkss
REAL::AREA ! 单元面积
REAL::UH(M) ! 无因次单位线
REAL::DT ! 时段步长
REAL::P(N) ! 降雨系列
REAL::EP(N) ! 蒸发皿蒸发能力
REAL::QR(N) ! 单元出流
REAL::W(3) ! 土壤含水层 1.上层 2.下层 3.深层
REAL::FR ! 初始产流面积
REAL::S ! 初始自由水深
REAL::QRSS0 ! 初始壤中流流量
REAL::QRG0 ! 初始地下水径流量
INTEGER::D
REAL::KSSD
REAL::KGD
REAL::E(3)
REAL::WM(3)
REAL::KC ! 蒸发能力折算系数
REAL::C ! 深层蒸发系数
REAL::B ! 张力水蓄水容量系数
REAL::IMP1 ! 不透水面积比率
REAL::SM ! 自由水蓄水容量
REAL::EX ! 自由水蓄水容量指数
REAL::KG ! 地下水出流系数
REAL::KSS ! 壤中流出流系数
REAL::KKG ! 地下水出流系数
REAL::KKSS ! 壤中流出流系数
REAL::KC ! 蒸发能力折算系数
REAL::C ! 深层蒸发系数
REAL::B ! 张力水蓄水容量系数
REAL::IMP1 ! 不透水面积比率
REAL::SM ! 自由水蓄水容量
REAL::EX ! 自由水蓄水容量指数
REAL::KG ! 地下水出流系数
REAL::KSS ! 壤中流出流系数
REAL::KKG ! 地下水出流系数
REAL::KKSS ! 壤中流出流系数
!以下变量是原vb程序中未声明的变量
INTEGER::I ! 计数器 //临时变量
INTEGER::J ! 计数器 //临时变量
INTEGER::ICHECK ! 判断计算时段长度是否合适的识别码
!以下变量是原vb程序中未声明的变量
INTEGER::I ! 计数器 //临时变量
INTEGER::J ! 计数器 //临时变量
INTEGER::ICHECK ! 判断计算时段长度是否合适的识别码
INTEGER::NN
REAL(KIND=8),PARAMETER::C5=5.000000000
@ -89,11 +89,11 @@ SUBROUTINE SUB_XAJMX( N ,& !
REAL::QRG
REAL::QTR
!///////////////////////////////////////变量声明//////////////////////////////////////////////
!///////////////////////////////////////变量声明//////////////////////////////////////////////
!///////////////////////////////////////计算区域//////////////////////////////////////////////
!///////////////////////////////////////计算区域//////////////////////////////////////////////
! 赋值
! 赋值
ICHECK = 1
DO I = 1, 3
@ -126,7 +126,8 @@ SUBROUTINE SUB_XAJMX( N ,& !
D = 24 / DT
CI = KKSS ** (1.0 / D)
CG = KKG ** (1.0 / D)
KSSD = (1.0 - (1.0 - (KG + KSS)) ** (1.0 / D)) / (1.0 + KG / KSS)
KSSD = (1.0 - (1.0 - (KG + KSS)) ** (1.0 / D)) &
/ (1.0 + KG / KSS)
KGD = KSSD * KG / KSS
ELSE
@ -148,7 +149,7 @@ SUBROUTINE SUB_XAJMX( N ,& !
W0 = W(1) + W(2) + W(3)
PE = P(I) - EP(I)
! 赋初值
! 赋初值
R = 0.0
RIMP = 0.0
@ -162,13 +163,15 @@ SUBROUTINE SUB_XAJMX( N ,& !
ELSE
A = WMM * (1.0 - (1.0 - W0 / WM0) ** (1.0 / (1.0 + B)))
A = WMM * (1.0 - (1.0 - W0 / WM0) **&
(1.0 / (1.0 + B)))
END IF
IF ((PE + A) .LT. WMM) THEN
R = PE - WM0 + W0 + WM0 * ((1.0 - (PE + A) / WMM) ** (1.0 + B))
R = PE - WM0 + W0 + WM0 * ((1.0 - (PE + A) /&
WMM) ** (1.0 + B))
ELSE
@ -244,9 +247,10 @@ SUBROUTINE SUB_XAJMX( N ,& !
S = X * S / FR
SS = S
Q = R / FR
NN = INT(Q / C5) + 1 ! 在vb程序中C5是双精度常数5
NN = INT(Q / C5) + 1 ! 在vb程序中C5是双精度常数5
Q = Q / NN
KSSDD = (1.0 - (1.0 - (KGD + KSSD)) ** (1.0 / NN)) / (1.0 + KGD / KSSD)
KSSDD = (1.0 - (1.0 - (KGD + KSSD)) ** (1.0 / NN))&
/ (1.0 + KGD / KSSD)
KGDD = KSSDD * KGD / KSSD
RS = 0.0
RSS = 0.0
@ -291,7 +295,8 @@ SUBROUTINE SUB_XAJMX( N ,& !
ELSE IF ((Q + AU) .LT. SMMF) THEN
RSD = (Q - SMF + S + SMF * (1.0 - (Q + AU) / SMMF) ** (1.0 + EX)) * FR
RSD = (Q - SMF + S + SMF * (1.0 - (Q + AU)&
/ SMMF) ** (1.0 + EX)) * FR
RSSD = (S + Q - RSD / FR) * KSSDD * FR
RGD = (S + Q - RSD / FR) * KGDD * FR
S = S + Q - (RSD + RSSD + RGD) / FR