📄 form1.frm
字号:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3480
ClientLeft = 4530
ClientTop = 3900
ClientWidth = 5610
LinkTopic = "Form1"
ScaleHeight = 3480
ScaleWidth = 5610
Begin VB.PictureBox Picture1
Height = 3255
Left = 2640
Picture = "Form1.frx":0000
ScaleHeight = 3195
ScaleWidth = 2835
TabIndex = 3
Top = 120
Width = 2895
End
Begin VB.TextBox Text1
Height = 270
Left = 1440
TabIndex = 1
Text = "Text1"
Top = 120
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "新安江三水源三层蒸发"
Height = 495
Left = 120
TabIndex = 0
Top = 480
Width = 2415
End
Begin VB.Shape Shape2
FillColor = &H000000FF&
FillStyle = 0 'Solid
Height = 375
Index = 2
Left = 1920
Shape = 3 'Circle
Top = 3000
Width = 375
End
Begin VB.Shape Shape2
FillColor = &H000000FF&
FillStyle = 0 'Solid
Height = 375
Index = 1
Left = 1200
Shape = 3 'Circle
Top = 3000
Width = 375
End
Begin VB.Shape Shape2
FillColor = &H000000FF&
FillStyle = 0 'Solid
Height = 375
Index = 0
Left = 360
Shape = 3 'Circle
Top = 3000
Width = 375
End
Begin VB.Label Label2
BackColor = &H0080FFFF&
BorderStyle = 1 'Fixed Single
Caption = "模型演示"
BeginProperty Font
Name = "宋体"
Size = 36
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF00FF&
Height = 1575
Left = 360
TabIndex = 4
Top = 1440
Width = 1935
End
Begin VB.Shape Shape1
BackColor = &H0000FF00&
BackStyle = 1 'Opaque
BorderColor = &H000000FF&
BorderStyle = 6 'Inside Solid
Height = 2295
Left = 120
Top = 1080
Width = 2415
End
Begin VB.Label Label1
BackColor = &H008080FF&
Caption = "运行结束标志"
BeginProperty Font
Name = "楷体_GB2312"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 255
Left = 120
TabIndex = 2
Top = 120
Width = 1215
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
XingAnJang5
End Sub
'新安江三水源，三层蒸发模型（时变单位线）
Function XingAnJang5() As Integer
Dim n As Integer, I As Integer, Qo As Single, ss As Single, F As Single, U As Single
Dim Wm As Single, Wum As Single, Wlm As Single, Wdm As Single, k As Single, b As Single, c As Single
Dim Sm As Single, Bx As Single, Kss As Single, Kg As Single, CRss As Single, CRg As Single, Immp As Single
Dim P As Single, E As Single, Pe As Single, Eu As Single, El As Single, EE As Single, FR0 As Single
Dim R As Single, Rs As Single, Rss As Single, Rg As Single, Q As Single, X As Single, XX As Single
Dim W As Single, Wu As Single, Wl As Single, Wd As Single, S As Single, Wmm As Single, Smm As Single
Dim QRss0 As Single, QRg0 As Single, Cr As Single, Cs As Single, Qz As Single, Qa() As Single
Qo = 20: ssp = 0: sse = 0: ssr = 0 'QO是基流。
Open App.Path + "\恩施9699\parm.txt" For Input As #1
Open App.Path + "\恩施9699\f9699.txt" For Input As #5
Open App.Path + "\恩施9699\end9699m.txt" For Output As #6
Input #1, Wm, Wum, Wlm, k, b, c, Sm, Bx, Kss, Kg, CRss, CRg, Immp
W = 85: Wu = 1: Wl = 60: S = 10: FR0 = 0: Dt = 3: F = 2928: U = F / (3.6 * Dt): QRss0 = 0: QRg0 = 10.1
Wmm = (1 + b) * Wm: Smm = (1 + Bx) * Sm: Wdm = Wm - Wum - Wlm: Wd = W - Wu - Wl: X = 1 / (1 + b): XX = 1 / (1 + Bx)
Cr = 0.02: ' Cx = 6
n = 0
Do Until EOF(5)
Line Input #5, TextLien
n = n + 1
Loop
Seek #5, 1
ReDim Qa(n + 1000)
For I = 1 To n
Input #5, n1, P, E, qb
Pe = P - k * E
If Pe > 0 Then
Eu = k * E: El = 0
XuManCanLiu Pe, R, Wm, Wmm, Wum, Wlm, Wdm, W, Wu, Wl, Wd, b, X
Else
R = 0
EuElEd P, k, E, Wlm, Wdm, Wu, Wl, Wd, Eu, El, Ed, c
End If
RsRssRg Pe, R, S, Sm, Smm, Rs, Rss, Rg, Bx, XX, FR0, Kss, Kg, Immp
EE = Eu + El + Ed: W = Wu + Wl + Wd
HeWangZongRuLiu Rs, Rss, Rg, QRss0, QRg0, Qz, CRg, CRss, Qo, U
Tao = 1
Cs = 1 - Cr * Qz ^ 0.4
Qa(I + Tao) = Cs * Qa(I) + (1 - Cs) * Qz
Q = Qa(I + Tao)
Write #6, I, Int(Rs * 100 + 0.05) / 100, Int(Rss * 100 + 0.05) / 100, Int(Rg * 100 + 0.05) / 100, Int(Q * 100 + 0.05) / 100
ssp = ssp + P: sse = sse + EE: ssr = ssr + R
Next I
Close (Fno)
Write #6, "结束", Int(ssp * 100 + 0.05) / 100, Int(sse * 100 + 0.05) / 100, Int(ssr * 100 + 0.05) / 100
Close (6)
Text1.Text = n
End Function
'蓄满产流函数二(三层蒸发)
Function XuManCanLiu(Pe, R, Wm, Wmm, Wum, Wlm, Wdm, W, Wu, Wl, Wd, b, X) As Integer
Dim Dr As Single, A As Single
If W < Wm Then
A = Wmm * (1 - (1 - W / Wm) ^ X)
Else
A = Wmm
End If
If Pe + A < Wmm Then
R = Pe - Wm + W + Wm * (1 - (Pe + A) / Wmm) ^ (1 + b)
Else
R = Pe + W - Wm
End If
If Wu + Pe - R < Wum Then
Wu = Wu + Pe - R
Else
Wl = Wl + Wu + Pe - R - Wum
Wu = Wum
If Wl > Wlm Then
Wd = Wd + Wl - Wlm
Wl = Wlm
If Wd > Wdm Then
Dr = Wd - Wdm
Wd = Wdm
R = R + Dr
End If
End If
End If
End Function
'三层蒸发函数
Function EuElEd(P, k, E, Wlm, Wdm, Wu, Wl, Wd, Eu, El, Ed, c) As Integer
If (Wu + P < k * E) Then
Eu = Wu + P: El = (k * E - Eu) * Wl / Wlm
Wu = 0
If El > c * (k * E - Eu) Then
Ed = 0: Wl = Wl - El
Else
If c * (k * E - Eu) <= Wl Then
El = c * (k * E - Eu): Ed = 0
Wl = Wl - El
Else
El = Wl: Ed = c * (k * E - Eu) - Wl
Wl = 0: Wd = Wd - Ed
If Wd < 0 Then
Ed = Ed + Wd: Wd = 0
End If
End If
End If
Else
Eu = k * E: El = 0: Ed = 0
Wu = Wu + P - Eu
End If
End Function
'三水源划分函数一
Function RsRssRg(Pe, R, S, Sm, Smm, Rs, Rss, Rg, Bx, XX, FR0, Kss, Kg, Immp) As Integer
Dim J As Integer, nn As Integer
Dim FR As Single, Au As Single, Smmf As Single, Smf As Single, RR As Single
Dim Rs0 As Single, Rss0 As Single, Rg0 As Single, Kss0 As Single, Kg0 As Single
Rs = 0: Rss = 0: Rg = 0
If R > 0 Then
FR = R / Pe
S = S * FR0 / FR
If FR < 1 Then
Smmf = Smm * (1 - (1 - FR) ^ (1 / Bx))
Else
Smmf = Smm
End If
Smf = Smmf / (1 + Bx)
nn = Int(Pe / 5) + 1
RR = Pe / nn
Kss0 = (1 - (1 - Kss - Kg) ^ (1 / nn)) / (1 + Kg / Kss)
Kg0 = Kss0 * Kg / Kss
For J = 1 To nn
If S < Smf Then
Au = Smmf * (1 - (1 - S / Smf) ^ XX)
Else
Au = Smmf
S = Smf
End If
If (RR + Au > Smmf) Then
Rs0 = (RR + S - Smf): S = Smf
Else
Rs0 = (RR - Smf + S + Smf * (1 - (RR + Au) / Smmf) ^ (1 + Bx))
S = S + RR - Rs0
End If
Rs = Rs + Rs0
Rss0 = S * Kss0: Rss = Rss + Rss0
Rg0 = S * Kg0: Rg = Rg + Rg0
S = S - (Rss0 + Rg0)
Next J
FR0 = FR
Else
Rs = 0
Rss = S * Kss
Rg = S * Kg
S = S - (Rss + Rg)
End If
Rs = Rs * FR0 * (1 - Immp) + Pe * Immp
Rss = Rss * FR0 * (1 - Immp)
Rg = Rg * FR0 * (1 - Immp)
End Function
'三水源河网总入流函数（地面径流直接入流）
Function HeWangZongRuLiu(Rs, Rss, Rg, QRss0, QRg0, Qz, CRg, CRss, Qo, U) As Integer
Dim Qs As Single, QRss As Single, QRg As Single
Qs = Rs * U
QRss = CRss * QRss0 + (1 - CRss) * Rss * U
QRg = CRg * QRg0 + (1 - CRg) * Rg * U
Qz = Qs + QRss + QRg + Qo
QRss0 = QRss: QRg0 = QRg
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -