d5r2.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8490
   ClientLeft      =   2055
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   8490
   ScaleWidth      =   4680
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3480
      TabIndex        =   0
      Top             =   6720
      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 D5R2
    'Driver for routine DDPOLY
    'Polynomial (X-1)^5
    Dim A(5) As String
    NC = 6
    NCM1 = 5
    NP = 20
    Dim C(6), PD(5), D(5, 20)
    A(1) = "polynomial:"
    A(2) = "first deriv:"
    A(3) = "second deriv:"
    A(4) = "third deriv:"
    A(5) = "fourth deriv:"
    C(1) = -1#
    C(2) = 5#
    C(3) = -10#
    C(4) = 10#
    C(5) = -5#
    C(6) = 1#
    For I = 1 To NP
        X = 0.1 * I
        Call DDPOLY(C(), NC, X, PD(), NC - 1)
        For J = 1 To NC - 1
            D(J, I) = PD(J)
        Next J
    Next I
    For I = 1 To NC - 1
        Print Tab(5); Format$(A(I), "###.###")
        Print Tab(5); "   X          DDPOLY       ACTUAL"
        For J = 1 To NP
            X = 0.1 * J
            Print Tab(5); Format$(X, "##.##000");
            Print Tab(18); Format$(D(I, J), "##.000000");
            AAA = FACTRL(NC - 1) / FACTRL(NC - I) * ((X - 1#) ^ (NC - I))
            Print Tab(31); Format$(AAA, "##.000000")
        Next J
        Print
    Next I
End Sub
Sub DDPOLY(C(), NC, X, PD(), ND)
    PD(1) = C(NC)
    For J = 2 To ND
        PD(J) = 0#
    Next J
    For I = NC - 1 To 1 Step -1
        If NC + 1 - I < ND Then
           NND = NC + 1 - I
        Else
           NND = ND
        End If
        For J = NND To 2 Step -1
            PD(J) = PD(J) * X + PD(J - 1)
        Next J
        PD(1) = PD(1) * X + C(I)
    Next I
    CONST1 = 2#
    For I = 3 To ND
        PD(I) = CONST1 * PD(I)
        CONST1 = CONST1 * I
    Next I
End Sub
Function FACTRL(N)
    Dim A(33)
    NTOP = 0
    A(1) = 1#
    If N < 0 Then
        Print "negative factorial"
        Exit Function
    ElseIf N <= NTOP Then
        FACTRL = A(N + 1)
    ElseIf N <= 32 Then
        For J = NTOP + 1 To N
            A(J + 1) = J * A(J)
        Next J
        NTOP = N
        FACTRL = A(N + 1)
    Else
        FACTRL = Exp(GAMMLN(N + 1#))
    End If
End Function
   Function GAMMLN(XX)
      Dim COF(6)
      COF(1) = 76.18009173
      COF(2) = -86.50532033
      COF(3) = 24.01409822
      COF(4) = -1.231739516
      COF(5) = 0.00120858003
      COF(6) = -0.00000536382
      STP = 2.50662827465
      HALF = 0.5
      ONE = 1#
      FPF = 5.5
      X = XX - ONE
      TMP = X + FPF
      TMP = (X + HALF) * Log(TMP) - TMP
      SER = ONE
      For J = 1 To 6
          X = X + ONE
          SER = SER + COF(J) / X
    Next J
      GAMMLN = TMP + Log(STP * SER)
   End Function