新安江模型VB代码

1、Dim P(25), EI(25), PE(25), A(25), AU(25), FR(25), W(25), WU(25), WL(25), WD(25), E(25), EU(25), EL(25), ED(25), R2(25), R3(25), RS(25), RG(25), RSS(25), RIMP(25), QR(25), QRG(25), QRSS(25), QRSP(25), S(25), UH(3), q(3) As SingleDim N, m, K, B, C, D, EX, SM, SSM, MP, KG, KSS, KKSS, KGD, KSSD, KKGD, K

2、KG, WM, WWMM, WUM, WLM, WDM, DT, UN, QRSS0, QRG0, F, i, j As SinglePrivate Sub Command1_Click()Static ik As Integerik = ik + 1Command1.Caption = "您还需计算" & 7 - ik & " 次"If ik = 7 Then Command1.Enabled = FalseSet xlbook = GetObject(App.Path & "" & "xa

3、j.xls")xlbook.application.Visible = True: xlbook.windows(1).Visible = TrueSet xlsheet1 = xlbook.worksheets("sheet1")Set xlsheet2 = xlbook.worksheets("sheet2")K = xlsheet1.Cells(3, 1)C = xlsheet1.Cells(3, 2)B = xlsheet1.Cells(3, 3)SM = xlsheet1.Cells(3, 5)WUM = xlsheet1.Cells

4、(3, 6)WLM = xlsheet1.Cells(3, 7)WDM = xlsheet1.Cells(3, 8)EX = xlsheet1.Cells(3, 9)KG = xlsheet1.Cells(3, 10)KSS = xlsheet1.Cells(3, 11)KKG = xlsheet1.Cells(3, 12)KKSS = xlsheet1.Cells(3, 13)DT = xlsheet1.Cells(3, 14)UH(1) = xlsheet1.Cells(3, 15)UH(2) = xlsheet1.Cells(3, 16)UH(3) = xlsheet1.Cells(3,

5、 17)WU(0) = xlsheet1.Cells(3, 18)WL(0) = xlsheet1.Cells(3, 19)WD(0) = xlsheet1.Cells(3, 20)FR(0) = xlsheet1.Cells(3, 21)S(0) = xlsheet1.Cells(3, 22)QRSS(0) = xlsheet1.Cells(3, 23)QRG(0) = xlsheet1.Cells(3, 24)F = xlsheet1.Cells(3, 25)MP = 0: RS(0) = 0: W(0) = 150WM = (WUM + WLM + WDM)WWMM = WM * (1

6、+ B)SSM = SM * (1 + EX)KSSD = (1 - (1 - (KG + KSS) (DT / 24) / (1 + KG / KSS)KGD = KSSD * KG / KSSKKGD = KKG (DT / 24) N = 24For i = 1 To N P(i) = xlsheet1.Cells(5, i + 1) EI(i) = xlsheet1.Cells(8, i + 1) PE(i) = P(i) - K * EI(i)Next iFor i = 1 To N '计算产流If PE(i) > 0 Then A(i) = WWMM * (1 - (

7、1 - W(i - 1) / WM) (1 / (1 + B)If PE(i) + A(i) >= WWMM Then R2(i) = PE(i) - (WM - W(i - 1)Else R2(i) = PE(i) - (WM - W(i - 1) - WM * (1 - (PE(i) + A(i) / WWMM) (1 + B)End IfIf PE(i) > 0 Then FR(i) = R2(i) / PE(i)Else FR(i) = 1 - (1 - S(i - 1) / WM) (B / (1 + B)End IfAU(i) = SSM * (1 - (1 - S(i

8、 - 1) / SM) (1 / (1 + EX)If PE(i) + AU(i) < SSM Then RS(i) = (PE(i) - SM + S(i - 1) + SM * (1 - (PE(i) + AU(i) / SSM) (1 + EX) * FR(i) RSS(i) = (SM - SM * (1 - (PE(i) + AU(i) / SSM) (1 + EX) * KSSD * FR(i) RG(i) = (SM - SM * (1 - (PE(i) + AU(i) / SSM) (1 + EX) * KGD * FR(i) S(i) = (SM - SM * (1 -

9、 (PE(i) + AU(i) / SSM) (1 + EX) * (1 - KSSD - KGD)Else RS(i) = (PE(i) - SM + S(i - 1) * FR(i) RSS(i) = SM * KSSD * FR(i) RG(i) = SM * KGD * FR(i) S(i) = SM * (1 - KSSD - KGD)End IfElse R2(i) = 0 FR(i) = 1 - (1 - W(i - 1) / WM) (B / (1 + B) RS(i) = 0 RSS(i) = S(i - 1) * KSSD * FR(i) RG(i) = S(i - 1)

10、* KGD * FR(i) S(i) = S(i - 1) * (1 - KSSD - KGD) End If RIMP(0) = 0 RIMP(i) = P(i) * MP R3(i) = RS(i) + RSS(i) + RG(i)Next iFor m = 1 To 3 计算汇流q(m) = F * UH(m) / (3.6 * DT)Next m QRSP(0) = 0 QRSP(1) = 0 * (RS(1) + RIMP(1) + q(1) * (RS(0) + RIMP(0) QRSP(2) = 0 * (RS(2) + RIMP(2) + q(1) * (RS(1) + RIM

11、P(1) + q(2) * (RS(0) + RIMP(0)For H = 3 To N QRSP(H) = 0 * (RS(H) + RIMP(H) + q(1) * (RS(H - 1) + RIMP(H - 1) + q(2) * (RS(H - 2) + RIMP(H - 2) + q(3) * (RS(H - 3) + RIMP(H - 3)Next HQRSS(0) = 40For L = 1 To NQRSS(L) = QRSS(L - 1) * KKSS (DT / 24) + RSS(L) * (1 - KKSS (DT / 24) * F / (3.6 * DT)Next

12、LQRG(0) = 20For L = 1 To NQRG(L) = QRG(L - 1) * KKGD (DT / 24) + RG(L) * (1 - KKGD (DT / 24) * F / (3.6 * DT)Next LFor m = 0 To NQR(m) = QRSP(m) + QRSS(m) + QRG(m)Next mFor j = 1 To N '计算蒸散发If WU(j - 1) + P(j) < K * EI(j) Then EU(j) = WU(j - 1) + P(j) If WL(j - 1) / WLM < C Then If WL(j -

13、1) < C * (K * EI(j) - EU(j) Then EL(j) = WL(j - 1) ED(j) = C * (K * EI(j) - EU(j) - EL(j) Else EL(j) = C * (K * EI(j) - EU(j) ED(j) = 0 End If Else EL(j) = (K * EI(j) - EU(j) * WL(j - 1) / WLM ED(j) = 0 End IfElse EU(j) = K * EI(j) EL(j) = 0 ED(j) = 0End If If WU(j - 1) + P(j) - R2(j) - EU(j) >

14、;= WUM Then If WL(j - 1) - EL(j) + WU(j - 1) + P(j) - R2(j) - EU(j) - WUM >= WLM Then WU(j) = WUM WL(j) = WLM If WD(j - 1) - ED(j) + (WL(j - 1) - EL(j) + WU(j - 1) + P(j) - R2(j) - EU(j) - WUM - WLM) >= WDM Then WD(j) = WDM End If Else WU(j) = WUM WL(j) = WL(j - 1) + EL(j) + (WU(j - 1) + P(j)

15、- R2(j) - EU(j) - WUM) WD(j) = WD(j - 1) - ED(j) End IfElse WU(j) = WU(j - 1) + P(j) - R2(j) - EU(j) WL(j) = WL(j - 1) - EL(j) WD(j) = WD(j - 1) - ED(j)End IfW(j) = WU(j) + WL(j) + WD(j)E(j) = EU(j) + EL(j) + ED(j)Next jFor j = 0 To N For L = 4 To 21xlsheet2.Cells(5 + j, L) = ""Next LNext

16、jFor j = 1 To N '输出 xlsheet2.Cells(5 + j, 2) = P(j) xlsheet2.Cells(5 + j, 3) = EI(j) xlsheet2.Cells(5 + j, 4) = PE(j) xlsheet2.Cells(5 + j, 5) = RS(j) xlsheet2.Cells(5 + j, 6) = RSS(j) xlsheet2.Cells(5 + j, 7) = RG(j) xlsheet2.Cells(5 + j, 8) = R3(j) 'xlsheet2.cells(5 + j, 9) = RIMP(j) xlsheet2.Cells(5 + j, 9) = S(j) xlsheet2.Cells(5 + j, 10) = EU(j) xlsheet2.Cells(5 + j, 11) = EL(j) xlsheet2.Cells(5 + j, 12) = ED(j) xlsheet2.Cells(5 + j, 13) = E(j) Next jFor H = 0 To N xlsheet2.Cells(5 + H, 14) = WU(H) xlsheet2.Cells(5 + H, 15) =