d2r8.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6720
   ClientLeft      =   1860
   ClientTop       =   540
   ClientWidth     =   6540
   LinkTopic       =   "Form1"
   ScaleHeight     =   6720
   ScaleWidth      =   6540
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4920
      TabIndex        =   0
      Top             =   6120
      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 D2R8
    'DRIVER for routine POLCOF
    NP = 5
    PI = 3.141593
    Dim XA(5), YA(5), COEFF(5)
    Print
    For NFUNC = 1 To 2
        If NFUNC = 1 Then
            Print Tab(3); "Sine function from 0 to PI"
            For I = 1 To NP
                XA(I) = I * PI / NP
                YA(I) = Sin(XA(I))
            Next I
        ElseIf NFUNC = 2 Then
            Print
            Print Tab(3); "Exponential function from 0 to 1"
            For I = 1 To NP
                XA(I) = 1# * I / NP
                YA(I) = Exp(XA(I))
            Next I
        Else
            Stop
        End If
        Call POLCOF(XA(), YA(), NP, COEFF())
        Print Tab(3); "coefficients"
        For I = 1 To NP
            Print Format$(COEFF(I), "0.000000"),
        Next I
        Print Tab(5); "  x         f(x)     polynomial"
        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
            Sum = COEFF(NP)
            For J = NP - 1 To 1 Step -1
                Sum = COEFF(J) + Sum * X
            Next J
            Print Tab(3); Format$(X, "0.#00000");
            Print Tab(15); Format$(F, "0.####00");
            Print Tab(27); Format$(Sum, "0.####00")
        Next I
        Print Tab(5); "**********************************'"
    Next NFUNC
End Sub
Sub POLCOF(XA(), YA(), N, COF())
    Dim X(15), Y(15)
    For J = 1 To N
        X(J) = XA(J)
        Y(J) = YA(J)
    Next J
    For J = 1 To N
        Call POLINT(X, Y, N + 1 - J, 0#, COF(J), DY)
        XMIN = 1E+38
        K = 0
        For I = 1 To N + 1 - J
            If Abs(X(I)) < XMIN Then
                XMIN = Abs(X(I))
                K = I
            End If
            If X(I) <> 0# Then Y(I) = (Y(I) - COF(J)) / X(I)
        Next I
        If K < N + 1 - J Then
            For I = K + 1 To N + 1 - J
                Y(I - 1) = Y(I)
                X(I - 1) = X(I)
            Next I
        End If
    Next J
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