d9r5.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5340
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7200
   LinkTopic       =   "Form1"
   ScaleHeight     =   5340
   ScaleWidth      =   7200
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   5640
      TabIndex        =   0
      Top             =   4680
      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 D9R5
    'Driver for routine SVDVAR
    MP = 6
    MA = 3
    NCVM = MA
    Dim V(6, 6), W(6), CVM(3, 3), TRU(3, 3)
    W(1) = 0#
    W(2) = 1#
    W(3) = 2#
    W(4) = 3#
    W(5) = 4#
    W(6) = 5#
    TRU(1, 1) = 1.25: TRU(1, 2) = 2.5: TRU(1, 3) = 3.75
    TRU(2, 1) = 2.5:  TRU(2, 2) = 5#:  TRU(2, 3) = 7.5
    TRU(3, 1) = 3.75: TRU(3, 2) = 7.5: TRU(3, 3) = 11.25
    For J = 1 To MP
        For I = 1 To MP
            V(I, J) = I
        Next I
    Next J
    Print Tab(5); "Matrix V"
    Print Tab(5)
    For I = 1 To MP
        For J = 1 To MP
            Print Format$(V(I, J), "#.000000"),
        Next J
        Print
    Next I
    Print
    Print Tab(5); "Matrix W"
    Print Tab(5)
    For I = 1 To MP
            Print Format$(W(I), "#.000000"),
    Next I
    Call SVDVAR(V(), MA, MP, W(), CVM(), NCVM)
    Print Tab(5)
    Print Tab(5); "Covariance matrix from SVDVAR"
    Print Tab(5)
    For I = 1 To MA
        For J = 1 To MA
            Print Format$(CVM(I, J), "#.000000"),
        Next J
        Print
    Next I
    Print Tab(5)
    Print "Expected covariance matrix"
    Print Tab(5)
    For I = 1 To MA
        For J = 1 To MA
            Print Format$(TRU(I, J), "#.000000"),
        Next J
        Print
    Next I
End Sub
Sub SVDVAR(V(), MA, NP, W(), CVM(), NCVM)
    Dim WTI(20)
    For I = 1 To MA
        WTI(I) = 0#
        If W(I) <> 0# Then WTI(I) = 1# / (W(I) * W(I))
    Next I
    For I = 1 To MA
        For J = 1 To I
            SUM1 = 0#
            For K = 1 To MA
                SUM1 = SUM1 + V(I, K) * V(J, K) * WTI(K)
            Next K
            CVM(I, J) = SUM1
            CVM(J, I) = SUM1
        Next J
    Next I
End Sub