d2r10.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3780
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6435
   LinkTopic       =   "Form1"
   ScaleHeight     =   3780
   ScaleWidth      =   6435
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4800
      TabIndex        =   0
      Top             =   3120
      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 D2R10
    'DRIVER for routine SPLIE2
    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 ^ 2
        Next J
    Next I
    Call SPLIE2(X1(), X2(), Y(), M, N, Y2())
    Print
    Print Tab(5); "Second derivatives from SPLIE2"
    Print Tab(5); "Natural spline assumed"
    For I = 1 To 5
        For J = 1 To 5
            Print Format$(Y2(I, J), "0.####00"),
        Next J
        Print
    Next I
    Print
    Print Tab(5); "Actual second derivatives"
    For I = 1 To 5
        For J = 1 To 5
            Y2(I, J) = 2# * (X1(I) ^ 2)
        Next J
        For J = 1 To 5
            Print Format$(Y2(I, J), "0.####00"),
        Next J
        Print
    Next I
End Sub
Sub SPLIE2(X1A(), X2A(), YA(), M, N, Y2A())
    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