southsaint.txt

圣维南方程组计算程序 vb开发 进行河道水流模拟计算

Option Explicit



Option Base 1



Const nsr As Integer = 200



Private ct, p, v, dtt As Single



Private ib As Integer



Private DXX(nsr), CNO(nsr), ZZ(nsr), QQ(nsr), PP(nsr), VV(nsr), SS(nsr), TT(nsr) As Single



Private n, l1, l2, ic As Integer



Const pi As Long = 3.1415926



Private Sub Command1_Click()



Dim de As Long



Dim delay As Long



Dim dx, cn, zu, x, zd, xx, yy As Single



Dim mt, dt, i, j, k As Integer



Open App.Path + "\resultsz.txt" For Output As #1



Open App.Path + "\resultsq.txt" For Output As #2



Open App.Path + "\inputdata.dat" For Input As #3



Input #3, dt, ct, cn, n



Close #3



For i = 1 To n



DXX(i) = 1 * 1000



CNO(i) = cn



ZZ(i) = 4 + 0.025 * (20 + 1 - i)



QQ(i) = 0



Next i



mt = 60 / dt



dt = dt * 60



dtt = 2 * dt



l1 = 1



l2 = n



ic = CInt(Text1.Text)



If ic = 1 Then



   ib = 0



   zu = 4.5



   ElseIf ic = 2 Then



   ib = 1



   zu = 500



   Else



   ib = 1



End If



For i = 1 To 149



    For j = 1 To mt



        x = i + j / mt



        zd = 4 + 1.5 * Sin(pi * x / 12)



        If ic = 1 Then



          p = zu



          v = 0



          ElseIf ic = 2 Then



            p = zu



            v = 0



            Else



            v = 20000000# / dt



            p = v * ZZ(l1)



         End If



         Call extern(l1, l2, ib)



         ZZ(l2) = zd



         QQ(l2) = p - v * zd



         Call back(l1, l2, ib)



         For k = 1 To n



         Print #1, ZZ(k),



         Print #2, QQ(k),



         Next k



         Print #1, Chr(13) + Chr(10);



         Print #2, Chr(13) + Chr(10);



         delay = 0



         For de = 1 To 200000



         delay = delay + 1



         Next de



         Picture1.Cls



         For k = 1 To n



         xx = 0.1 + 0.5 * k



         yy = 8 - ZZ(k) / 1#



            If k = 1 Then



               Picture1.PSet (xx, yy), RGB(0, 0, 255)



               Else



               Picture1.Line -(xx, yy), RGB(0, 0, 255)



            End If



          Next k



         Picture2.Cls



         For k = 1 To n



         xx = 0.1 + 0.5 * k



         yy = 4 - QQ(k) / 200#



            If k = 1 Then



               Picture2.PSet (xx, yy), RGB(0, 0, 255)



               Else



               Picture2.Line -(xx, yy), RGB(0, 0, 255)



            End If



          Next k



     Next j



Next i



Close #1



Close #2



End Sub



Sub extern(l1, l2, ib)



Dim i As Integer



Dim rdx As Single



Dim z1, q1, b1, a1, r1, u1, z2, q2, b2, a2, r2, u2, c, d, e, f, g, fei, y1, y2, y3, y4, w, s, t, dx, sa, sb, bc As Single



z1 = ZZ(l1)



q1 = QQ(l1)



Call abr(l1, z1, q1, b1, a1, r1, u1)



PP(l1) = p



VV(l1) = v



For i = l1 + 1 To l2



    z2 = ZZ(i)



    q2 = QQ(i)



    Call abr(i, z2, q2, b2, a2, r2, u2)



    dx = DXX(i)



    rdx = dx * 4.905 * CNO(i) * CNO(i) / ct



    sa = rdx * (Abs(u1) + 0.01) / r1 ^ 1.333



    sb = rdx * (Abs(u1) + 0.01) / r2 ^ 1.333



    bc = (b1 + b2) * 0.5



    c = dx / dtt * bc / ct



    d = c * (z1 + z2) - (1 - ct) / ct * (q2 - q1)



    e = dx / dtt / ct - u1 + sa



    g = dx / dtt / ct + u2 + sb



    f = 9.81 * (a1 + a2) * 0.5



    fei = dx / dtt / ct * (q1 + q2) - (1 - ct) / ct * (u2 * q2 - u1 * q1)



    fei = fei - (1 - ct) / ct * f * (z2 - z1)



    If ib = 0 Then



       y1 = d - c * p



       y2 = fei + f * p



       y3 = 1 + c * v



       y4 = e + f * v



       w = c * y4 + f * y3



       s = (c * y2 - f * y1) / w



       t = (c * g - f) / w



       p = (y1 + y3 * s) / c



       v = (1 + t * y3) / c



       Else



       y1 = c + v



       y2 = f + e * v



       y3 = fei - e * p



       y4 = d + p



       w = g * y1 + y2



       s = (g * y4 - y3) / w



       t = (c * g - f) / w



       p = y4 - y1 * s



       v = c - y1 * t



    End If



    PP(i) = p: VV(i) = v: SS(i) = s: TT(i) = t: z1 = z2: q1 = q2: u1 = u2: b1 = b2: a1 = a2: r1 = r2



Next i



If ib = 0 Then



p = p / v: v = 1 / v



End If




 


End Sub



Sub back(l1, l2, ib)



Dim i As Integer



If ib = 0 Then



       For i = l2 - 1 To l1 Step -1



          QQ(i) = SS(i + 1) - TT(i + 1) * QQ(i + 1)



          ZZ(i) = PP(i) - VV(i) * QQ(i)



       Next i



   Else



       For i = l2 - 1 To l1 Step -1



           ZZ(i) = SS(i + 1) - TT(i + 1) * ZZ(i + 1)



           QQ(i) = PP(i) - VV(i) * ZZ(i)



        Next i



End If



End Sub




 


Sub abr(i, z, q, b, a, r, u)



Dim zd, dh As Single



zd = 0.1 * (n - i)



dh = z - zd



b = 100 + 6 * dh



a = (b + 100) * dh / 2：r = a / b



If r < 0.1 Then r = 0.1



u = q / a



End Sub