d2r6.frm

VB常用数值算法集 内含有解线性代数方程组

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5265
   ClientLeft      =   1860
   ClientTop       =   945
   ClientWidth     =   5460
   LinkTopic       =   "Form1"
   ScaleHeight     =   5265
   ScaleWidth      =   5460
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4080
      TabIndex        =   0
      Top             =   4560
      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 D2R6
    'DRIVER for routine HUNT
    N = 100
    Dim XX(100)
    'Create array to be searched
    For I = 1 To N
        XX(I) = Exp(I / 20#) - 74#
    Next I
    Print
    Print Tab(5); "  Result of:    J=0 indicates x too small"
    Print Tab(5); "                J=100 indicates x too large"
    Print Tab(5); " locate   guess   J       xx(J)        xx(J+1)"
    'FOR test
    For I = 1 To 19
        X = -100# + 200# * I / 20#
    'Trial parameter
        JI = 5 * I
        J% = JI
    'Begin search
        Call HUNT(XX, N, X, J%)
        If J% = 0 Then
            Print Tab(4); Format$(X, "#0.00000");
            Print Tab(16); Format$(JI, "00");
            Print Tab(22); Format$(J%, "00");
            Print Tab(29); "lower lim";
            Print Tab(42); Format$(XX(J% + 1), "##.####00")
        ElseIf J% = N Then
            Print Tab(4); Format$(X, "#0.00000");
            Print Tab(16); Format$(JI, "00");
            Print Tab(22); Format$(J%, "00");
            Print Tab(29); Format$(XX(J%), "##.####00");
            Print Tab(42); "upper lim"
        Else
            Print Tab(4); Format$(X, "#0.00000");
            Print Tab(16); Format$(JI, "00");
            Print Tab(22); Format$(J%, "00");
            Print Tab(29); Format$(XX(J%), "##.####00");
            Print Tab(42); Format$(XX(J% + 1), "##.####00");
        End If
    Next I
End Sub
Sub HUNT(XX(), N, X, JLO%)
    ASCND = XX(N) > XX(1)
    If JLO% <= 0 Or JLO% > N Then
        JLO% = 0
        LHI% = N + 1
        GoTo 3
    End If
    INC% = 1
    If X >= XX(JLO%) Eqv ASCND Then
1       LHI% = JLO% + INC%
        If LHI% > N Then
            LHI% = N + 1
        ElseIf X >= XX(LHI%) Eqv ASCND Then
            JLO% = LHI%
            INC% = INC% + INC%
            GoTo 1
        End If
    Else
        LHI% = JLO%
2       JLO% = LHI% - INC%
        If JLO% < 1 Then
            JLO% = 0
        ElseIf X < XX(JLO%) Eqv ASCND Then
            LHI% = JLO%
            INC% = INC% + INC%
            GoTo 2
        End If
    End If
3   If LHI% - JLO% = 1 Then
        Exit Sub
    End If
    JM% = (LHI% + JLO%) / 2
    If X > XX(JM%) Eqv ASCND Then
        JLO% = JM%
    Else
        LHI% = JM%
    End If
    GoTo 3
End Sub