MSJGMX/Fortran/XAJMX.f90

412 lines
8.4 KiB
Fortran
Raw Normal View History

2025-05-09 14:01:19 +08:00
SUBROUTINE XAJMX( FILELEN ,&
N ,& ! <20><>Ԫ<EFBFBD><D4AA><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>С //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
M ,& ! <20><><EFBFBD><EFBFBD><EFBFBD>ε<EFBFBD>λ<EFBFBD><CEBB><EFBFBD><EFBFBD><EFBFBD><EFBFBD>С //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
PAR ,& ! //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
AREA ,& ! <20><>Ԫ<EFBFBD><D4AA><EFBFBD><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
UH ,& ! <20><><EFBFBD><EFBFBD><EFBFBD>ε<EFBFBD>λ<EFBFBD><CEBB> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
DT ,& ! ʱ<>β<EFBFBD><CEB2><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
P ,& ! <20><><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
EP ,& ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
W ,& ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE> 1.<2E>ϲ<EFBFBD> 2.<2E>²<EFBFBD> 3.<2E><><EFBFBD><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FR ,& ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
S ,& ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
QRSS0 ,& ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
QRG0 ,& ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
QR ) ! <20><>Ԫ<EFBFBD><D4AA><EFBFBD><EFBFBD> //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
IMPLICIT NONE
!///////////////////////////////////////<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>//////////////////////////////////////////////
INTEGER::N !
INTEGER::M !
REAL::PAR(13) ! 1.<2E>ϲ<EFBFBD><CFB2><EFBFBD><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>wum 2.<2E>²<EFBFBD><C2B2><EFBFBD><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>wl 3.<2E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>wdm
! 4.<2E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>KC.<2E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>c 6.<2E><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>b
! 7.<2E><>͸ˮ<CDB8><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>imp1 8.<2E><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>sm 9.<2E><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ָ<EFBFBD><D6B8>ex
!10.<2E><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>kg 11.<2E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>kss 12.<2E><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>kkg
!13.<2E><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>kkss
REAL::AREA ! <20><>Ԫ<EFBFBD><D4AA><EFBFBD><EFBFBD>
REAL::UH(M) ! <20><><EFBFBD><EFBFBD><EFBFBD>ε<EFBFBD>λ<EFBFBD><CEBB>
REAL::DT ! ʱ<>β<EFBFBD><CEB2><EFBFBD>
REAL::P(N) ! <20><><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
REAL::EP(N) ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
REAL::QR(N) ! <20><>Ԫ<EFBFBD><D4AA><EFBFBD><EFBFBD>
REAL::W(3) ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE> 1.<2E>ϲ<EFBFBD> 2.<2E>²<EFBFBD> 3.<2E><><EFBFBD><EFBFBD>
REAL::FR ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
REAL::S ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE>
REAL::QRSS0 ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
REAL::QRG0 ! <20><>ʼ<EFBFBD><CABC><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
INTEGER::D
REAL::KSSD
REAL::KGD
REAL::E(3)
REAL::WM(3)
REAL::KC ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
REAL::C ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
REAL::B ! <20><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
REAL::IMP1 ! <20><>͸ˮ<CDB8><CBAE><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
REAL::SM ! <20><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>
REAL::EX ! <20><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ָ<EFBFBD><D6B8>
REAL::KG ! <20><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
REAL::KSS ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
REAL::KKG ! <20><><EFBFBD><EFBFBD>ˮ<EFBFBD><CBAE><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
REAL::KKSS ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>ϵ<EFBFBD><CFB5>
!<21><><EFBFBD>±<EFBFBD><C2B1><EFBFBD><EFBFBD><EFBFBD>ԭvb<76><62><EFBFBD><EFBFBD><EFBFBD><EFBFBD>δ<EFBFBD><CEB4><EFBFBD><EFBFBD><EFBFBD>ı<EFBFBD><C4B1><EFBFBD>
INTEGER::I ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //<2F><>ʱ<EFBFBD><CAB1><EFBFBD><EFBFBD>
INTEGER::J ! <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> //<2F><>ʱ<EFBFBD><CAB1><EFBFBD><EFBFBD>
INTEGER::ICHECK ! <20>жϼ<D0B6><CFBC><EFBFBD>ʱ<EFBFBD>γ<EFBFBD><CEB3><EFBFBD><EFBFBD>Ƿ<EFBFBD><C7B7><EFBFBD><EFBFBD>ʵ<EFBFBD>ʶ<EFBFBD><CAB6><EFBFBD><EFBFBD>
INTEGER::NN
REAL(KIND=8),PARAMETER::C5=5.000000000
REAL::U
REAL::CI
REAL::CG
REAL::WM0
REAL::W0
REAL::PE
REAL::R
REAL::RIMP
REAL::WMM
REAL::A
REAL::X
REAL::RS
REAL::RSS
REAL::RGD
REAL::RG
REAL::SS
REAL::Q
REAL::KSSDD
REAL::KGDD
REAL::SMM
REAL::SMMF
REAL::SMF
REAL::AU
REAL::RSD
REAL::RSSD
REAL::QRS
REAL::QRSS
REAL::QRG
REAL::QTR
INTEGER:: FILELEN
REAL::WTEMP(3)
REAL::FRTEMP
REAL::STEMP
REAL::QRSS0TEMP
REAL::QRG0TEMP
!///////////////////////////////////////<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>//////////////////////////////////////////////
DO I = 1,3
WTEMP(I) = W(I)
END DO
FRTEMP = FR
STEMP =S
QRSS0TEMP=QRSS0
QRG0TEMP=QRG0
!///////////////////////////////////////<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>//////////////////////////////////////////////
D = 0
KSSD = 0.0
KGD = 0.0
do i = 1,3
E(I)=0.0
WM(I) =0.0
END DO
KC = 0.0
C = 0.0
B = 0.0
IMP1 = 0.0
SM = 0.0
EX = 0.0
KG = 0.0
KSS = 0.0
KKG = 0.0
KKSS = 0.0
U = 0.0
CI = 0.0
CG = 0.0
WM0 = 0.0
W0 = 0.0
PE = 0.0
R = 0.0
RIMP = 0.0
WMM = 0.0
A = 0.0
X = 0.0
RS = 0.0
RSS = 0.0
RGD = 0.0
RG = 0.0
SS = 0.0
Q = 0.0
KSSDD = 0.0
KGDD = 0.0
SMM = 0.0
SMMF = 0.0
SMF = 0.0
AU = 0.0
RSD = 0.0
RSSD = 0.0
QRS = 0.0
QRSS = 0.0
QRG = 0.0
QTR = 0.0
! <20><>ֵ
ICHECK = 1
DO I = 1, 3
WM(I) = PAR(I)
END DO
KC = PAR(4)
C = PAR(5)
B = PAR(6)
IMP1 = PAR(7)
SM = PAR(8)
EX = PAR(9)
KG = PAR(10)
KSS = PAR(11)
KKG = PAR(12)
KKSS = PAR(13)
DO I = 1, N
QR(I) = 0.0
END DO
U = AREA / 3.6 / DT
IF( DT.LE.24.0 )THEN
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)
KGD = KSSD * KG / KSS
ELSE
ICHECK = 0
END IF
DO I = 1 , N
IF (EP(I) .LT. 0.0)THEN
EP(I) = 0.0
END IF
IF (P(I) .LT. 0.0)THEN
P(I) = 0.0
END IF
EP(I) = EP(I) * KC
WM0 = WM(1) + WM(2) + WM(3)
W0 = W(1) + W(2) + W(3)
PE = P(I) - EP(I)
! <20><><EFBFBD><EFBFBD>ֵ
R = 0.0
RIMP = 0.0
IF(PE.GT.0.0)THEN
WMM = (1.0 + B) * WM0 / (1.0 - IMP1)
IF ((WM0 - W0).LE.0.0001)THEN
A = WMM
ELSE
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))
ELSE
R = PE - (WM0 - W0)
END IF
RIMP = PE * IMP1
END IF
IF ((W(1) + P(I)) .GT. EP(I)) THEN
E(1) = EP(I)
E(2) = 0.0
E(3) = 0.0
ELSE
E(1) = W(1) + P(I)
E(2) = (EP(I) - E(1)) * W(2) / WM(2)
IF (W(2) .LE.( C * WM(2))) THEN
E(2) = C * (EP(I) - E(1))
E(3) = 0.0
IF (W(2) .GE. (C * (EP(I) - E(1)))) THEN
E(2) = C * (EP(I) - E(1))
E(3) = 0.0
ELSE
E(2) = W(2)
E(3) = C * (EP(I) - E(1) - E(2))
END IF
END IF
END IF
W(1) = W(1) + P(I) - R - E(1)
W(2) = W(2) - E(2)
W(3) = W(3) - E(3)
IF (W(1) .GT. WM(1)) THEN
W(2) = W(1) - WM(1) + W(2)
W(1) = WM(1)
IF (W(2) .GT. WM(2)) THEN
W(3) = W(3) + W(2) - WM(2)
W(2) = WM(2)
END IF
END IF
X = FR
IF (PE .LE.0.0) THEN
RS = 0.0
RSS = S * KSSD * FR
RGD = S * FR * KGD
S = S - (RSS + RG) / FR
ELSE
FR = R / PE
S = X * S / FR
SS = S
Q = R / FR
NN = INT(Q / C5) + 1 ! <20><>vb<76><62><EFBFBD><EFBFBD><EFBFBD><EFBFBD>C5<43><35>˫<EFBFBD><CBAB><EFBFBD>ȳ<EFBFBD><C8B3><EFBFBD>5
Q = Q / NN
KSSDD = (1.0 - (1.0 - (KGD + KSSD)) ** (1.0 / NN)) /&
(1.0 + KGD / KSSD)
KGDD = KSSDD * KGD / KSSD
RS = 0.0
RSS = 0.0
RG = 0.0
SMM = (1 + EX) * SM
IF (EX .LT. 0.001) THEN
SMMF = SMM
ELSE
SMMF = SMM * (1.0 - (1.0 - FR) ** (1.0 / EX))
END IF
SMF = SMMF / (1.0 + EX)
DO J = 1 , NN
IF (S .GT. SMF) THEN
S = SMF
END IF
AU = SMMF * (1.0 - (1.0 - S / SMF) ** (1.0 /&
(1.0 + EX)))
IF ((Q + AU) .LE. 0.0) THEN
RSD = 0.0
RSSD = 0.0
RGD = 0.0
S = 0.0
ELSE IF ((Q + AU) .GE. SMMF) THEN
RSD = (Q + S - SMF) * FR
RSSD = SMF * KSSDD * FR
RGD = SMF * FR * KGDD
S = SMF - (KSSD + KGD) / FR
ELSE IF ((Q + AU) .LT. SMMF) THEN
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
END IF
RS = RS + RSD
RSS = RSS + RSSD
RG = RG + RGD
END DO
END IF
RS = RS * (1.0 - IMP1)
RSS = RSS * (1.0 - IMP1)
RG = RG * (1.0 - IMP1)
QRS = (RS + RIMP) * U
QRSS = QRSS0 * CI + RSS * (1.0 - CI) * U
QRG = QRG0 * CG + RG * (1.0 - CG) * U
QTR = QRS + QRSS + QRG
DO J = 1 , M
IF ((I + J - 1) .LE. N) THEN
QR(I + J - 1) = QR(I + J - 1) + QTR * UH(J)
END IF
END DO
QRSS0 = QRSS
QRG0 = QRG
END DO
DO I = 1,3
W(I) = WTEMP(I)
END DO
FR = FRTEMP
S =STEMP
QRSS0=QRSS0TEMP
QRG0=QRG0TEMP
END SUBROUTINE XAJMX