d2r11.frm

VB常用数值算法集 内含有解线性代数方程组

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3390
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5475
   LinkTopic       =   "Form1"
   ScaleHeight     =   3390
   ScaleWidth      =   5475
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3960
      TabIndex        =   0
      Top             =   2640
      Width           =   1095
   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 D2R11
    'DRIVER for routine SPLIN2
    M = 10
    N = 10
    Dim X1(10), X2(10), Y(10, 10), Y2(10, 10)
    For I = 1 To M
        X1(I) = 0.2 * I
    Next I
    For I = 1 To N
        X2(I) = 0.2 * I
    Next I
    For I = 1 To M
        For J = 1 To N
            X1X2 = X1(I) * X2(J)
            Y(I, J) = X1X2 * Exp(-X1X2)
        Next J
    Next I
    Call SPLIE2(X1(), X2(), Y(), M, N, Y2())
    Print
    Print Tab(5); "  X1         X2          SPLIN2        ACTUAL"
    For I = 1 To 10
        XX1 = 0.1 * I
        XX2 = XX1 ^ 2
        Call SPLIN2(X1(), X2(), Y(), Y2(), M, N, XX1, XX2, F)
        X1X2 = XX1 * XX2
        FF = X1X2 * Exp(-X1X2)
        Print Tab(3); Format$(XX1, "0.###000"),
        Print Format$(XX2, "0.###000"),
        Print Format$(F, "0.###000"),
        Print Format$(FF, "0.###000")
    Next I
End Sub
Sub SPLIN2(X1A(), X2A(), YA(), Y2A(), M, N, X1, X2, Y)
    Dim YTMP(100), Y2TMP(100), YYTMP(100)
    For J = 1 To M
        For K = 1 To N
            YTMP(K) = YA(J, K)
            Y2TMP(K) = Y2A(J, K)
        Next K
        Call SPLINT(X2A, YTMP, Y2TMP, N, X2, YYTMP(J))
    Next J
    Call SPLINE(X1A, YYTMP, M, 1E+30, 1E+30, Y2TMP)
    Call SPLINT(X1A, YYTMP, Y2TMP, M, X1, Y)
End Sub
   Sub SPLIE2(X1A(), X2A(), YA(), M, N, Y2A())
      NN = 100
      Dim YTMP(100), Y2TMP(100)
      For J = 1 To M
          For K = 1 To N
              YTMP(K) = YA(J, K)
          Next K
          Call SPLINE(X2A(), YTMP(), N, 1E+30, 1E+30, Y2TMP())
          For K = 1 To N
              Y2A(J, K) = Y2TMP(K)
          Next K
      Next J
   End Sub
   Sub SPLINE(X(), Y(), N, YP1, YPN, Y2())
      Dim U(100)
      If YP1 > 9.9E+29 Then
          Y2(1) = 0
          U(1) = 0
      Else
          Y2(1) = -0.5
          AAA = (Y(2) - Y(1)) / (X(2) - X(1))
          U(1) = (3# / (X(2) - X(1))) * (AAA - YP1)
      End If
      For I = 2 To N - 1
          SIG = (X(I) - X(I - 1)) / (X(I + 1) - X(I - 1))
          P = SIG * Y2(I - 1) + 2#
          Y2(I) = (SIG - 1#) / P
          AAA = (Y(I + 1) - Y(I)) / (X(I + 1) - X(I))
          BBB = (Y(I) - Y(I - 1)) / (X(I) - X(I - 1))
          CCC = X(I + 1) - X(I - 1)
          U(I) = (6# * (AAA - BBB) / CCC - SIG * U(I - 1)) / P
      Next I
      If YPN > 9.9E+29 Then
          QN = 0#
          UN = 0#
      Else
          QN = 0.5
          AAA = YPN - (Y(N) - Y(N - 1)) / (X(N) - X(N - 1))
          UN = (3# / (X(N) - X(N - 1))) * AAA
      End If
      Y2(N) = (UN - QN * U(N - 1)) / (QN * Y2(N - 1) + 1#)
      For K = N - 1 To 1 Step -1
          Y2(K) = Y2(K) * Y2(K + 1) + U(K)
      Next K
   End Sub
    Sub SPLINT(XA(), YA(), Y2A(), N, X, Y)
       KLO = 1
       KHI = N
1        If KHI - KLO > 1 Then
             K = (KHI + KLO) / 2
             If XA(K) > X Then
                 KHI = K
             Else
                 KLO = K
             End If
             GoTo 1
         End If
       H = XA(KHI) - XA(KLO)
       If H = 0 Then
          Print "  PAUSE  'BAD  XA  INPUT'"
          Exit Sub
       End If
       A = (XA(KHI) - X) / H
       B = (X - XA(KLO)) / H
       AAA = A * YA(KLO) + B * YA(KHI)
       BBB = (A ^ 3 - A) * Y2A(KLO) + (B ^ 3 - B) * Y2A(KHI)
       Y = AAA + BBB * (H ^ 2) / 6#
    End Sub