d16r1.frm

VB常用数值算法集1 VB常用数值算法集1

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6330
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8070
   LinkTopic       =   "Form1"
   ScaleHeight     =   6330
   ScaleWidth      =   8070
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   6360
      TabIndex        =   0
      Top             =   5640
      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()
    'PROGRAM D16R1
    'Driver for routine SOR
    JMAX = 11
    PI = 3.1415926
    Dim A(11, 11), B(11, 11), C(11, 11), D(11, 11)
    Dim E(11, 11), F(11, 11), U(11, 11)
    For I = 1 To JMAX
        For J = 1 To JMAX
            A(I, J) = 1#
            B(I, J) = 1#
            C(I, J) = 1#
            D(I, J) = 1#
            E(I, J) = -4#
            F(I, J) = 0#
            U(I, J) = 0#
        Next J
    Next I
    MIDL = JMAX / 2 + 1
    F(MIDL, MIDL) = 2#
    RJAC = Cos(PI / JMAX)
    Call SOR(A(), B(), C(), D(), E(), F(), U(), JMAX, RJAC)
    Print
    Print Tab(5); "SOR Solution:"
    Print
    For I = 1 To JMAX
        For J = 1 To JMAX
            Print Tab(5 + (J - 1) * 8); Format$(U(I, J), "#.#0");
        Next J
    Next I
    Print Tab(5)
    Print Tab(5); "Test that sulotion satisfies Difference Eqns:"
    Print
    For I = 2 To JMAX - 1
      For J = 2 To JMAX - 1
        AAA = U(I + 1, J) + U(I - 1, J) + U(I, J + 1) + U(I, J - 1)
        F(I, J) = AAA - 4# * U(I, J)
      Next J
      For J = 2 To JMAX - 1
        Print Tab(5 + (J - 2) * 8); Format$(F(I, J), "#.#0");
      Next J
    Next I
End Sub
Sub SOR(A(), B(), C(), D(), E(), F(), U(), JMAX, RJAC)
    MAXITS = 1000
    EPS = 0.00001
    ZERO = 0#
    HALF = 0.5
    QTR = 0.25
    ONE = 1#
    ANORMF = ZERO
    For J = 2 To JMAX - 1
        For L = 2 To JMAX - 1
            ANORMF = ANORMF + Abs(F(J, L))
        Next L
    Next J
    OMEGA = ONE
    For N = 1 To MAXITS
        ANORM = ZERO
        For J = 2 To JMAX - 1
          For L = 2 To JMAX - 1
            If (J + L) Mod 2 = N Mod 2 Then
              AAA = A(J, L) * U(J + 1, L) + B(J, L) * U(J - 1, L)
              BBB = C(J, L) * U(J, L + 1) + D(J, L) * U(J, L - 1)
              RESID = AAA + BBB + E(J, L) * U(J, L) - F(J, L)
              ANORM = ANORM + Abs(RESID)
              U(J, L) = U(J, L) - OMEGA * RESID / E(J, L)
            End If
          Next L
        Next J
        If N = 1 Then
            OMEGA = ONE / (ONE - HALF * RJAC ^ 2)
        Else
            OMEGA = ONE / (ONE - QTR * RJAC ^ 2 * OMEGA)
        End If
        If N > 1 And ANORM < EPS * ANORMF Then Exit Sub
    Next N
    Print " MAXITS exceeded"
End Sub