From 6c7785fc6c0fca95a3bcc2517982db1cc0c8aa80 Mon Sep 17 00:00:00 2001 From: zzx <784670282@qq.com> Date: Fri, 9 May 2025 13:45:09 +0800 Subject: [PATCH] =?UTF-8?q?=E6=9B=B4=E6=96=B0=20Fortran/SUB=5FXAJMX.f90?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- Fortran/SUB_XAJMX.f90 | 115 ++++++++++++++++++++++-------------------- 1 file changed, 60 insertions(+), 55 deletions(-) diff --git a/Fortran/SUB_XAJMX.f90 b/Fortran/SUB_XAJMX.f90 index a8c87ad..033ccb4 100644 --- a/Fortran/SUB_XAJMX.f90 +++ b/Fortran/SUB_XAJMX.f90 @@ -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.涓婂眰寮犲姏姘村閲弚um 2.涓嬪眰寮犲姏姘村閲弚l 3.娣卞眰寮犲姏姘村閲弚dm + ! 4.钂稿彂鑳藉姏鎶樼畻绯绘暟KC.娣卞眰钂稿彂绯绘暟c 6.寮犲姏姘磋搫姘村閲忕郴鏁癰 + ! 7.涓嶉忔按闈㈢Н姣旂巼imp1 8.鑷敱姘磋搫姘村閲弒m 9.鑷敱姘磋搫姘村閲忔寚鏁癳x + !10.鍦颁笅姘村嚭娴佺郴鏁発g 11.澹や腑娴佸嚭娴佺郴鏁発ss 12.鍦颁笅姘村嚭娴佺郴鏁発kg + !13.澹や腑娴佸嚭娴佺郴鏁発kss + 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 ! 鍦╲b绋嬪簭涓瑿5鏄弻绮惧害甯告暟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