d11r8.txt

常用的数值算法的VB程序

Private Sub Command1_Click()
    'PROGRAM D11R8
    'Driver for routine FRPRMN
    NDIM = 3
    PIO2 = 1.5707963
    FTOL = 0.000001
    Dim P(3)
    Print Tab(5); "PROGRAM finds the minimum of a function"
    Print Tab(5); "with different trial starting vectors."
    Print Tab(5); "True minimum is (0.5, 0.5, 0.5)"
    For K = 0 To 4
        ANGL = PIO2 * K / 4#
        P(1) = 2# * Cos(ANGL)
        P(2) = 2# * Sin(ANGL)
        P(3) = 0#
        Print Tab(5)
        Print Tab(5); "Starting vector: ("; Format$(P(1), "#.#000");
        Print ","; Format$(P(2), "#.#000"); ","; Format$(P(3), "#.#000"); ")"
        Call FRPRMN(P(), NDIM, FTOL, ITER, FRET)
        Print Tab(5); "Iterations: "; Format$(ITER, "##")
        Print Tab(5); "Solution vector: ("; Format$(P(1), "#.#000");
        Print ","; Format$(P(2), "#.#000"); ","; Format$(P(3), "#.#000"); ")"
        Print Tab(5); "Func. value at solution", Format$(FRET, ".######E+00")
    Next K
End Sub
Function FUNC2(X(), N)
    FUNC2 = 1# - BESSJ0(X(1) - 0.5) * BESSJ0(X(2) - 0.5) * BESSJ0(X(3) - 0.5)
End Function
Sub DFUNC(X(), DF())
    DF(1) = BESSJ1(X(1) - 0.5) * BESSJ0(X(2) - 0.5) * BESSJ0(X(3) - 0.5)
    DF(2) = BESSJ0(X(1) - 0.5) * BESSJ1(X(2) - 0.5) * BESSJ0(X(3) - 0.5)
    DF(3) = BESSJ0(X(1) - 0.5) * BESSJ0(X(2) - 0.5) * BESSJ1(X(3) - 0.5)
End Sub
Function FUNC(X)
    FUNC = F1DIM(X)
End Function