d2r1.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6285
   ClientLeft      =   1860
   ClientTop       =   540
   ClientWidth     =   6315
   LinkTopic       =   "Form1"
   ScaleHeight     =   6285
   ScaleWidth      =   6315
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4440
      TabIndex        =   0
      Top             =   5640
      Width           =   1335
   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 D2R1
    'Driver for routine POLINT
    N = 9    '输入插值节点个数
    PI = 3.1415926
    Dim XA(10), YA(10)
    Print Tab(5); "Generation of interpolation tables"
    Print Tab(5); " ... sin(x)    0 < x < PI"
    Print Tab(5); " ... exp(x)    0 < x < 1"
    Print Tab(5); "How many entries go in these tables?(Note: N<10)"
    Print Tab(5); N
    For NFUNC = 1 To 2
        If NFUNC = 1 Then
            Print Tab(5); "sine function from 0 to PI"
            For I = 1 To N
                XA(I) = I * PI / N
                YA(I) = Sin(XA(I))
            Next I
        ElseIf NFUNC = 2 Then
            Print Tab(5); "exponential function from 0 to 1"
            For I = 1 To N
                XA(I) = I * 1# / N
                YA(I) = Exp(XA(I))
            Next I
        Else
            Exit Sub
        End If
        Print Tab(5); "     x           f(x)       interpolated        error"
        For I = 1 To 10
            If NFUNC = 1 Then
                X = (-0.05 + I / 10#) * PI
                F = Sin(X)
            ElseIf NFUNC = 2 Then
                X = (-0.05 + I / 10#)
                F = Exp(X)
            End If
            Call POLINT(XA(), YA(), N, X, Y, DY)
            Print Tab(5); Format$(X, "0.##0000");
            Print Tab(20); Format$(F, "0.####00");
            Print Tab(35); Format$(Y, "0.####00");
            Print Tab(50); Format$(DY, ".##00E+00")
        Next I
    Next NFUNC
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