d9r7.frm

数据拟合源程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5025
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6285
   LinkTopic       =   "Form1"
   ScaleHeight     =   5025
   ScaleWidth      =   6285
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4800
      TabIndex        =   0
      Top             =   4320
      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 D9R7
    'Driver for routine FLEG
    NVAL = 5
    DX = 0.2
    NPOLY = 5
    Dim AFUNC(5)
    Print Tab(5); "Legendre Polynomials"
    Print Tab(10); "N=1     N=2     N=3     N=4     N=5"
    For I = 1 To NVAL
        X = I * DX
        Call FLEG(X, AFUNC(), NPOLY)
        Print Tab(5); "X = "; X
        For J = 1 To NPOLY
            Print Tab(J * 8); Format$(AFUNC(J), ".###0");
        Next J
        Print Tab(48); "routine FLEG"
        For J = 1 To NPOLY
            Print Tab(J * 8); Format$(PLGNDR(J - 1, 0, X), ".###0");
        Next J
        Print Tab(48); "routine PLGNDR"
        Print
    Next I
End Sub
Sub FLEG(X, PL(), NL)
    PL(1) = 1#
    PL(2) = X
    If NL > 2 Then
        TWOX = 2# * X
        F2 = X
        D = 1#
        For J = 3 To NL
            F1 = D
            F2 = F2 + TWOX
            D = D + 1#
            PL(J) = (F2 * PL(J - 1) - F1 * PL(J - 2)) / D
        Next J
    End If
End Sub
Function PLGNDR(L, M, X)
    If M < 0 Or M > L Or Abs(X) > 1# Then Print "bad arguments"
      PMM = 1#
      If M > 0 Then
          SOMX2 = Sqr((1# - X) * (1# + X))
          FACT = 1#
          For I = 1 To M
              PMM = -PMM * FACT * SOMX2
              FACT = FACT + 2#
          Next I
      End If
      If L = M Then
          PLGNDR = PMM
      Else
          PMMP1 = X * (2 * M + 1) * PMM
          If L = M + 1 Then
              PLGNDR = PMMP1
          Else
              For LL = M + 2 To L
                  PLL = (X * (2 * LL - 1) * PMMP1 - (LL + M - 1) * PMM) / (LL - M)
                  PMM = PMMP1
                  PMMP1 = PLL
              Next LL
              PLGNDR = PLL
          End If
      End If
End Function