d3r8.frm

矩阵特征值的求解过程之三

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4710
   LinkTopic       =   "Form1"
   ScaleHeight     =   3195
   ScaleWidth      =   4710
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3000
      TabIndex        =   0
      Top             =   2520
      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 D3R8
    'Driver for routine QGAUS
    X1 = 0#
    X2 = 5#
    NVAL = 10
    DX = (X2 - X1) / NVAL
    Print
    Print Tab(5); "0.0to     QGAUS       Expected"
    For I = 1 To NVAL
        X = X1 + I * DX
        Call QGAUS(X1, X, SS)
        Print Tab(5); Format$(X, "##.#0");
        Print Tab(14); Format$(SS, "0.######");
        AAA = -(1# + X) * Exp(-X) + (1# + X1) * Exp(-X1)
        Print Tab(27); Format$(AAA, "0.######")
    Next I
End Sub
Function FUNC(X)
    FUNC = X * Exp(-X)
End Function
Sub QGAUS(A, B, SS)
    Dim X(5), W(5)
    X(1) = 0.1488743389
    X(2) = 0.4333953941
    X(3) = 0.6794095682
    X(4) = 0.8650633666
    X(5) = 0.9739065285
    W(1) = 0.2955242247
    W(2) = 0.2692667193
    W(3) = 0.2190863625
    W(4) = 0.1494513491
    W(5) = 0.0666713443
    XM = 0.5 * (A + B)
    XR = 0.5 * (B - A)
    SS = 0#
    For J = 1 To 5
        DX = XR * X(J)
        SS = SS + W(J) * (FUNC(XM + DX) + FUNC(XM - DX))
    Next J
    SS = XR * SS
End Sub