d11r9.txt

来自「VB常用数值算法集2」· 文本 代码 · 共 36 行

Private Sub Command1_Click()
      'PROGRAM D11R9
      'Driver for routine DFPMIN
      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 DFPMIN(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
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 FUNC2(X(), N)
    FUNC2 = 1# - BESSJ0(X(1) - 0.5) * BESSJ0(X(2) - 0.5) * BESSJ0(X(3) - 0.5)
End Function
Function FUNC(X)
    FUNC = F1DIM(X)
End Function