d4r31.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4725
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4920
   LinkTopic       =   "Form1"
   ScaleHeight     =   4725
   ScaleWidth      =   4920
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3120
      TabIndex        =   0
      Top             =   3960
      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
    Open "D:\VB常用数值算法集\DATA\FNCVAL.DAT" For Input As #1
    Do
      Line Input #1, Text$
    Loop While Text$ <> "Exponential Integral Bs"
    Line Input #1, NVAL$
    NVAL = Val(NVAL$)
    Print Text$
    Print
    Print "   N      B         Actual          BS(N,B)"
    For I = 1 To NVAL
        Line Input #1, DUM$
        N = Val(Mid(DUM$, 1, 7))
        B = Val(Mid(DUM$, 8, 8))
        ACTUAL = Val(Mid(DUM$, 16))
        Print Tab(4); Format$(N, "#0.##");
        Print Tab(10); Format$(B, "#0.##");
        Print Tab(18); Format$(ACTUAL, ".0000000E+00");
        Print Tab(34); Format$(BS(N, B), ".0000000E+00")
    Next I
    Close #1
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