MSJGMX/Fortran/XAJ.f90
2025-05-09 14:01:19 +08:00

111 lines
4.6 KiB
Fortran

SUBROUTINE XAJ(FILELEN ,&
NODE ,& ! 单元出流数组大小 //输入变量
M ,& ! 无因次单位数组大小 //输入变量
PAR ,& ! //输入变量
NAREA ,& ! 单元面积个数 //输入变量
AREA ,& ! 单元面积 //输入变量
UH ,& ! 无因次单位线 //输入变量
DT ,& ! 时段步长 //输入变量
P ,& ! 降雨系列 //输入变量
EP ,& ! 蒸发皿蒸发能力 //输入变量
W ,& ! 土壤含水层 1.上层 2.下层 3.深层 //输入变量
FR ,& ! 初始产流面积 //输入变量
S ,& ! 初始自由水深 //输入变量
QRSS0 ,& ! 初始壤中流流量 //输入变量
QRG0 ,& ! 初始地下水径流量 //输入变量
Q20 ,& ! 出流流量初始值 浮点数 //输入
X ,& ! 流量比重因子 浮点数 //输入参数
K ,& ! 流量模数 浮点数 //输入参数
DETAT ,& ! 时间步长 (小时) 浮点数 //输入参数
C0 ,& ! 系数 浮点数 //输出参数
C1 ,& ! 浮点数 //输出参数
C2 ,& ! 浮点数 //输出参数
QOUT ) ! 出流流量 浮点数 //输出
IMPLICIT NONE
INTEGER::NODE
REAL::X
REAL::K
REAL::DETAT
REAL::C0
REAL::C1
REAL::C2
INTEGER:: FILELEN
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
integer::NAREA ! 单元面积个数 //输入变量
REAL::AREA(NAREA) ! 单元面积
REAL::Q1(NAREA,NODE)
REAL::UH(M) ! 无因次单位线
REAL::DT ! 时段步长
REAL::P(NAREA,NODE) ! 降雨系列
REAL::EP(NAREA,NODE) ! 蒸发皿蒸发能力
REAL::QR(NAREA,NODE) ! 单元出流
REAL::W(3) ! 土壤含水层 1.上层 2.下层 3.深层
REAL::FR ! 初始产流面积
REAL::S ! 初始自由水深
REAL::QRSS0 ! 初始壤中流流量
REAL::QRG0 ! 初始地下水径流量
REAL::Q2(NAREA,NODE)
INTEGER::I,J
REAL::QOUT(NODE)
REAL::Q20(NAREA)
DO I = 1,NODE
QOUT(I) = 0.0
END DO
DO I =1,NAREA
CALL XAJMX( FILELEN ,&
NODE ,& ! 单元出流数组大小 //输入变量
M ,& ! 无因次单位数组大小 //输入变量
PAR ,& ! //输入变量
AREA(I) ,& ! 单元面积 //输入变量
UH ,& ! 无因次单位线 //输入变量
DT ,& ! 时段步长 //输入变量
P(I,:) ,& ! 降雨系列 //输入变量
EP(I,:) ,& ! 蒸发皿蒸发能力 //输入变量
W ,& ! 土壤含水层 1.上层 2.下层 3.深层 //输入变量
FR ,& ! 初始产流面积 //输入变量
S ,& ! 初始自由水深 //输入变量
QRSS0 ,& ! 初始壤中流流量 //输入变量
QRG0 ,& ! 初始地下水径流量 //输入变量
QR(I,:) ) ! 单元出流 //输出变量
DO J = 1,NAREA
Q1(J,:)=QR(J,:)
END DO
CALL Mc_method( FILELEN ,& ! 文件名字长度 整数 //输入参数
NODE ,& ! 入流流量数据点个数 整数 //输入参数
Q1(I,:) ,& ! 入流流量 浮点数 //输入参数
Q20(I) ,& ! 出流流量初始值 浮点数 //输入
X ,& ! 流量比重因子 浮点数 //输入参数
K ,& ! 流量模数 浮点数 //输入参数
DETAT ,& ! 时间步长 (小时) 浮点数 //输入参数
C0 ,& ! 系数 浮点数 //输出参数
C1 ,& ! 浮点数 //输出参数
C2 ,& ! 浮点数 //输出参数
Q2(I,:) ) ! 出流流量 浮点数 //输出
END DO
DO I = 1,NAREA
DO J = 1,NODE
QOUT(J)= Q2(I,J) + QOUT(J)
END DO
END DO
END SUBROUTINE XAJ