d11r2.txt

常用的数值算法的VB程序

Private Sub Command1_Click()
    'PROGRAM D11R2
     'Driver for routine GOLDEN
     TOL = 0.000001
     EQL = 0.001
     Dim AMIN(20)
     NMIN = 0
     Print
     Print Tab(5); "Minima of the function BESSJ0"
     Print
     Print Tab(3); "Min. #         X          BESSJ0(X)      BESSJ1(X)"
     For I = 1 To 100
         AX = I
         BX = I + 1#
         Call MNBRAK(AX, BX, CX, FA, FB, FC)
         G = GOLDEN(AX, BX, CX, TOL, XMIN)
         If NMIN = 0 Then
             AMIN(1) = XMIN
             NMIN = 1
             Print Tab(5); Format$(NMIN, "##");
             Print Tab(15); Format$(XMIN, "##.####00");
             Print Tab(29); Format$(BESSJ0(XMIN), ".#####0");
             Print Tab(43); Format$(BESSJ1(XMIN), ".#####0")
         Else
             IFLAG = 0
             For j = 1 To NMIN
                 If Abs(XMIN - AMIN(j)) <= EQL * XMIN Then IFLAG = 1
             Next j
             If IFLAG = 0 Then
                 NMIN = NMIN + 1
                 AMIN(NMIN) = XMIN
                 Print Tab(5); Format$(NMIN, "##");
                 Print Tab(15); Format$(XMIN, "##.####00");
                 Print Tab(29); Format$(BESSJ0(XMIN), ".#####0");
                 Print Tab(43); Format$(BESSJ1(XMIN), ".#####0")
             End If
         End If
     Next I
End Sub
Function FUNC(X)
    FUNC = BESSJ0(X)
End Function