form1.frm

一个用VB编写的一维四点格式算法的源程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4860
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6525
   LinkTopic       =   "Form1"
   ScaleHeight     =   4860
   ScaleWidth      =   6525
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   4080
      TabIndex        =   0
      Top             =   3600
      Width           =   1455
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

'四点偏心法，上下边界条件均为水位
'T为时间间隔，JP为每小时里的时层数，CN为糙率，M为计算时段的小时数，
'p为断面数，p1为间距数，
Const T = 180, JP = 20, P1 = 20, CN = 0.037, M = 36, P = 21

Dim Z0(P), Z1(P), Z2(P), W0(P), W1(P), W2(P), W3(P), ZP(2)
Private Sub Command1_Click()
'四点偏心法为两层格式，定义两个时层的流量Q，水位Z，河宽B，截面面积A，边界断面每个小时节点的水位ZB，断面间距X
'定义断面形状的参数，Z0,Z1,Z2,W0,W1,W2,W3分别为断面中两个梯形的高和宽，ZP(2)是为了首末断面插值而设，r为四点偏心的系数
IP = 1: R = 0.65
Dim Q(2, P), Z(2, P), B(2, P), A(2, P), ZB(2, M), X(P1)
'LL,MM,PP,RR分别为四点偏心格式里面的
'Qn-1=Ln+Mn*Qn
'Zn=Pn+Rn*Qn
'里的Ln，Mn，Pn，Rn
Dim LL(P), MM(P), PP(P), RR(P), ZZ(P)
Open "in.txt" For Input As #1
Open "out.txt" For Output As #2
'首末断面第m个小时的水位
For i = 1 To 2
    For j = 1 To M
        Input #1, ZB(i, j)
    Next j
Next i
'令初始流量为100，如果格式稳定，误差将在计算中消除
For i = 1 To P
    Q(1, i) = 50
Next i
'内插每个断面初始水位
For i = 1 To P
    Z(1, i) = ZB(1, 1) + (ZB(2, 1) - ZB(1, 1)) * (i - 1) / P1
Next i
'间距
For i = 1 To P1
    Input #1, X(i)
Next i
'断面形状参数
For i = 1 To P
    Input #1, Z0(i), Z1(i), Z2(i)
Next i
For i = 1 To P
    Input #1, W0(i), W1(i), W2(i), W3(i)
Next
Dim it As Integer
'计算各个断面面积和宽度
For i = 1 To P
    it = i
    Call A_and_B(A(1, i), B(1, i), Z(1, i), it)
Next i
'Print #2, "断面";
For i = 1 To P
        Q(2, i) = Q(1, i)
        Z(2, i) = Z(1, i)
        A(2, i) = A(1, i)
        B(2, i) = B(1, i)
Next i
For i = 1 To 21
    Print #2, Tab(10 * i); "#" & (i);
Next i
Print #2,
For n = 1 To JP * M - JP
    'If dd > 0.02 Then n = n - 1
    If n Mod JP = 0 Then Print n / JP, "hour"

    '内插该时层的水位值，因为边界条件只有每个小时的水位值，而时间间隔为60s
    For i = 1 To 2
        ZP(i) = ZB(i, IP) + (n - (IP - 1) * JP) / JP * (ZB(i, IP + 1) - ZB(i, IP))
    Next i
    If n Mod JP = 0 Then IP = IP + 1
    '计算边界断面面积和河宽
    Z(2, 1) = ZP(1)
    Z(2, P) = ZP(2)
    'Call A_and_B(A(2, 1), B(2, 1), Z(2, 1), 1)
    'Call A_and_B(A(2, P), B(2, P), Z(2, P), P)
    '开始第一趟扫描
    RR(1) = 0
    PP(1) = ZP(1)
100    For i = 1 To P1
        BM = 0.5 * ((1 - R) * (B(1, i) + B(1, i + 1)) + R * (B(2, i) + B(2, i + 1)))
        AM = 0.5 * ((1 - R) * (A(1, i) + A(1, i + 1)) + R * (A(2, i) + A(2, i + 1)))
        QM = 0.5 * ((1 - R) * (Q(1, i) + Q(1, i + 1)) + R * (Q(2, i) + Q(2, i + 1)))
        ZM = 0.5 * ((1 - R) * (Z(1, i) + Z(1, i + 1)) + R * (Z(2, i) + Z(2, i + 1)))
        C1 = 2 * R * T / X(i) / BM
        E1 = Z(1, i) + Z(1, i + 1) + ((1 - R) / R) * C1 * (Q(1, i) - Q(1, i + 1))
        A2 = 2 * R * T / X(i) * ((QM / AM) ^ 2 * BM - 9.8 * AM)
        C9 = T / X(i) * QM / AM
        C2 = 1 - 4 * R * C9
        D2 = 1 + 4 * R * C9
        Call A_and_B(F8, B8, ZM, i)
        Call A_and_B(F9, B9, ZM, i + 1)
        E2 = (1 - R) / R * A2 * (Z(1, i + 1) - Z(1, i)) + (1 - 4 * (1 - R) * C9) * Q(1, i + 1)
        E2 = E2 + (1 + 4 * (1 - R) * C9) * Q(1, i) + 2 * T * (QM / AM) ^ 2 * (F9 - F8) / X(i)
        E2 = E2 - 2 * T * 9.8 * CN * CN * QM * QM * BM / AM / AM / (AM / BM) ^ (1 / 3)
        Y1 = RR(i) - C1
        Y2 = A2 * RR(i) + C2
        Y3 = E1 - PP(i)
        Y4 = E2 - A2 * PP(i)
        Y5 = Y2 + A2 * Y1
        LL(i + 1) = (A2 * Y3 + Y4) / Y5
        MM(i + 1) = -(D2 + A2 * C1) / Y5
        PP(i + 1) = (Y2 * Y3 - Y1 * Y4) / Y5
        RR(i + 1) = (Y1 * D2 - Y2 * C1) / Y5
    Next i
    '开始第二趟扫描
    ZZ(P) = ZP(2)
    Q(2, P) = (ZZ(P) - PP(P)) / RR(P)
    For i = P - 1 To 1 Step -1
        Q(2, i) = LL(i + 1) + MM(i + 1) * Q(2, i + 1)
        ZZ(i) = PP(i) + RR(i) * Q(2, i)
    Next i
    dd = Abs(Z(2, 1) - ZZ(1))
    For i = 2 To P
        If dd < Abs(Z(2, i) - ZZ(i)) Then dd = Abs(Z(2, i) - ZZ(i))
    Next i
    For i = 1 To P
        Z(2, i) = ZZ(i)
        Call A_and_B(A(2, i), B(2, i), Z(2, i), i)
    Next i
    If dd > 0.02 Then GoTo 100
  
    If n Mod JP = 0 Then
        Print #2, "Z";
        For i = 1 To P Step 2
            
            Print #2, Tab(10 * i); Format(Z(2, i), "##.##");
            
       
        Next
        Print #2,
        Print #2, "Q";
        For i = 2 To P1 Step 2
            
            Print #2, Tab(10 * i); Format(Q(2, i), "######");
        Next
        Print #2,
            
        
    End If
    For i = 1 To P
        Q(1, i) = Q(2, i)
        Z(1, i) = Z(2, i)
        A(1, i) = A(2, i)
        B(1, i) = B(2, i)
    Next i
Next n
Close #1
Close #2

        
        
    
End Sub
Private Sub A_and_B(A, B, Z, it)


ZH = Z - Z0(it)
If ZH <= Z1(it) - Z0(it) Then
   B = W0(it) + (W1(it) - W0(it)) / (Z1(it) - Z0(it)) * ZH
   A = (W0(it) + B) / 2 * ZH
Else
   B = W2(it) + (W3(it) - W2(it)) / (Z2(it) - Z1(it)) * (ZH - Z1(it) + Z0(it))
   A = (W2(it) + B) / 2 * (ZH - Z1(it) + Z0(it)) + (W0(it) + W1(it)) / 2 * (Z1(it) - Z0(it))
 
End If

End Sub