d5r4.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5010
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   5010
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3120
      TabIndex        =   0
      Top             =   4320
      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 D5R4
     'Driver for routine CHEBFT
     NVAL = 40
     PIO2 = 1.5707963
     EPS = 0.000001
     Dim C(40)
     A = -PIO2
     B = PIO2
     Call CHEBFT(A, B, C(), NVAL)
    'Test result
     Print
     Print Tab(5); "How many terms in Chebyshev evaluation?"
     'Input MVAL , between 1 and 40, MVAL=0 TO END
     MVAL = 20
     Print Tab(5); MVAL
     If (MVAL <= 0) Or (MVAL > NVAL) Then Exit Sub
     Print Tab(5); "   X          Actual       Chebyshev fit"
     For I = -8 To 8 Step 1
         X = I * PIO2 / 10#
         Y = (X - 0.5 * (B + A)) / (0.5 * (B - A))
     'Evaluate Chebyshev polynomial without using
     'routine CHEBEV
         T0 = 1#
         T1 = Y
         F = C(2) * T1 + C(1) * 0.5
         For J = 3 To MVAL
             DUM = T1
             T1 = 2# * Y * T1 - T0
             T0 = DUM
             TERM = C(J) * T1
             F = F + TERM
         Next J
         Print Tab(4); Format$(X, ".##0000");
         Print Tab(19); Format$(FUNC(X), "#.###000");
         Print Tab(33); Format$(F, "#.###000")
     Next I
End Sub
Function FUNC(X)
    FUNC = (X ^ 2) * (X ^ 2 - 2#) * Sin(X)
End Function
Sub CHEBFT(A, B, C(), N)
    NMAX = 50
    Dim F(50)
    PI = 3.14159265358979
    BMA = 0.5 * (B - A)
    BPA = 0.5 * (B + A)
    For K = 1 To N
        Y = Cos(PI * (K - 0.5) / N)
        F(K) = FUNC(Y * BMA + BPA)
    Next K
    FAC = 2# / N
    For J = 1 To N
        Sum = 0#
        For K = 1 To N
            Sum = Sum + F(K) * Cos((PI * (J - 1)) * ((K - 0.5) / N))
        Next K
        C(J) = FAC * Sum
    Next J
End Sub