d2r9.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5160
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7050
   LinkTopic       =   "Form1"
   ScaleHeight     =   5160
   ScaleWidth      =   7050
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   5280
      TabIndex        =   0
      Top             =   4560
      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 D2R9
    'DRIVER for routine POLIN2
    N = 5
    PI = 3.141593
    Dim X1A(5), X2A(5), YA(5, 5)
    For I = 1 To N
        X1A(I) = I * PI / N
        For J = 1 To N
            X2A(J) = 1# * J / N
            YA(I, J) = Sin(X1A(I)) * Exp(X2A(J))
        Next J
    Next I
    'Test 2-dimensional interpolation
    Print
    Print Tab(5); "   x1            x2         f(x)     interpolated    error"
    For I = 1 To 4
        X1 = (-0.1 + I / 5#) * PI
        For J = 1 To 4
            X2 = -0.1 + J / 5#
            F = Sin(X1) * Exp(X2)
            Call POLIN2(X1A(), X2A(), YA(), N, N, X1, X2, Y, DY)
            Print Tab(5); Format$(X1, "0.###000");
            Print Tab(18); Format$(X2, "0.###000");
            Print Tab(31); Format$(F, "0.###000");
            Print Tab(44); Format$(Y, "0.###000");
            Print Tab(57); Format$(DY, "0.###000");
        Next J
        Print Tab(5); "**********************************"
    Next I
End Sub
Sub POLIN2(X1A(), X2A(), YA(), M, N, X1, X2, Y, DY)
    Dim YNTMP(20), YMTMP(20)
    For J = 1 To M
        For K = 1 To N
            YNTMP(K) = YA(J, K)
        Next K
        Call POLINT(X2A(), YNTMP(), N, X2, YMTMP(J), DY)
    Next J
    Call POLINT(X1A(), YMTMP, M, X1, Y, DY)
End Sub
   Sub POLINT(XA(), YA(), N, X, Y, DY)
      Dim C(10), D(10)
      NS = 1
      DIF = Abs(X - XA(1))
      For I = 1 To N
          DIFT = Abs(X - XA(I))
          If DIFT < DIF Then
              NS = I
              DIF = DIFT
          End If
          C(I) = YA(I)
          D(I) = YA(I)
      Next I
      Y = YA(NS)
      NS = NS - 1
      For M = 1 To N - 1
          For I = 1 To N - M
              HO = XA(I) - X
              HP = XA(I + M) - X
              W = C(I + 1) - D(I)
              DEN = HO - HP
              If DEN = 0# Then
                 Print "PAUSE"
                 Exit Sub
              End If
              DEN = W / DEN
              D(I) = HP * DEN
              C(I) = HO * DEN
          Next I
          If 2 * NS < N - M Then
              DY = C(NS + 1)
          Else
              DY = D(NS)
              NS = NS - 1
          End If
          Y = Y + DY
      Next M
   End Sub