d4r31.frm

来自「常用数值算法集哈」· FRM 代码 · 共 107 行

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   2670
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4620
   LinkTopic       =   "Form1"
   ScaleHeight     =   2670
   ScaleWidth      =   4620
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   2760
      TabIndex        =   0
      Top             =   2040
      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 D4R31
    'Driver for routine BS
    Dim ACTUAL(5), B(5), N(5)
    ACTUAL(1) = -0.1677107
    ACTUAL(2) = -0.1007459
    ACTUAL(3) = -0.07200876
    ACTUAL(4) = 1103713000#
    ACTUAL(5) = 1015570000#
    N(1) = 2
    N(2) = 4
    N(3) = 6
    N(4) = 1
    N(5) = 3
    B(1) = 0.25
    B(2) = 0.25
    B(3) = 0.25
    B(4) = 24#
    B(5) = 24#
    Print
    Print "   N      B         Actual          BS(N,B)"
    For I = 1 To 5
        Print Tab(4); Format$(N(I), "#0.##");
        Print Tab(10); Format$(B(I), "#0.##");
        Print Tab(18); Format$(ACTUAL(I), ".0000000E+00");
        Print Tab(34); Format$(BS(N(I), B(I)), ".0000000E+00")
    Next I
End Sub
Function BS(N, A)
    Dim B(20)
    If A = 0# Then
       If N / 2 = N / 2# Then
         B(N) = 0#
         GoTo 15
       End If
       B(N) = 2# / N
       GoTo 15
    End If
    If Abs(A) < 8# Then
       DEL = 0.00000001
       If N / 2 <> N / 2# Then
         R = 2# / N
         EPS = R * DEL
         S = R
         AK = 0#
         A2 = A * A
5        AK = AK + 2#
         R = R * A2 * (N + AK - 2#) / (AK * (AK - 1#) * (N + AK))
         S = S + R
         If R > EPS Then GoTo 5
         B(N) = S + R
         GoTo 15
       End If
       R = 2# * A / (N + 1#)
       OMEG = Abs(R * DEL)
       S = R
       AK = 1#
       A2 = A * A
6      AK = AK + 2#
       R = R * A2 * (N + AK - 2#) / (AK * (AK - 1#) * (N + AK))
       S = S + R
       If Abs(R) > OMEG Then GoTo 6
       B(N) = -(S + R)
       GoTo 15
    End If
    DA = 1# / A
    AJP = DA * Exp(A)
    AJM = (DA * DA) / AJP
    B(1) = AJP - AJM
    If N = 1 Then GoTo 15
    Q1 = -1#
    Q2 = 1#
    For M = 2 To N
        B(M) = Q1 * AJP - AJM + Q2 * DA * B(M - 1)
        Q1 = -Q1
        Q2 = Q2 + 1#
    Next M
15  BS = B(N)
End Function