d2r2.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3240
      TabIndex        =   0
      Top             =   2760
      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 D2R2
    'DRIVER for routine RATINT
    NPT = 6
    Dim X(6), Y(6)
    For I = 1 To NPT
        X(I) = I * 2# / NPT
        Y(I) = FUNC(X(I))
    Next I
    Print
    Print Tab(5); "Diagonal rational function interpolation"
    Print Tab(5); " x       interap.    accuracy       actual"
    For I = 1 To 10
        XX = 0.2 * I
        Call RATINT(X(), Y(), NPT, XX, YY, DYY)
        YEXP = FUNC(XX)
        Print Tab(5); Format$(XX, "#.#0");
        Print Tab(13); Format$(YY, ".####00");
        Print Tab(25); Format$(DYY, ".0000E+00");
        Print Tab(40); Format$(YEXP, ".######")
    Next I
End Sub
Function FUNC(X)
    FUNC = X * Exp(-X) / ((X - 1#) ^ 2 + 1#)
End Function
Sub RATINT(XA(), YA(), N, X, Y, DY)
    TINY = 1E-25
    Dim C(10), D(10)
    NS = 1
    HH = Abs(X - XA(1))
    For I = 1 To N
        H = Abs(X - XA(I))
        If H = 0 Then
            Y = YA(I)
            DY = 0#
            Exit Sub
        ElseIf H < HH Then
            NS = I
            HH = H
        End If
        C(I) = YA(I)
        D(I) = YA(I) + TINY
    Next I
    Y = YA(NS)
    NS = NS - 1
    For M = 1 To N - 1
        For I = 1 To N - M
            W = C(I + 1) - D(I)
            H = XA(I + M) - X
            T = (XA(I) - X) * D(I) / H
            DD = T - C(I + 1)
            If DD = 0# Then
                Print "PAUSE"
                Exit Sub
            End If
            DD = W / DD
            D(I) = C(I + 1) * DD
            C(I) = T * DD
        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