d4r17.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5055
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4110
   LinkTopic       =   "Form1"
   ScaleHeight     =   5055
   ScaleWidth      =   4110
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   2160
      TabIndex        =   0
      Top             =   4320
      Width           =   1455
   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 D4R17
    'Driver for routine BESSJ1
    Open "D:\VB常用数值算法集\DATA\FNCVAL.DAT" For Input As #1
    Do
      Line Input #1, Text$
    Loop While Text$ <> "Bessel Function J1"
    Line Input #1, NVAL$
    NVAL = Val(NVAL$)
    Print Text$
    Print
    Print "     X       Actual      BESSJ1(X)"
    For I = 1 To NVAL
        Line Input #1, DUM$
        X = Val(Mid(DUM$, 1, 6))
        Value = Val(Mid(DUM$, 7))
        Print Tab(4); Format$(X, "#0.0#");
        Print Tab(12); Format$(Value, "##.0000000");
        Print Tab(25); Format$(BESSJ1(X), "##.0000000")
    Next I
    Close #1
End Sub
Function BESSJ1(X)
    R1 = 72362614232#:           R2 = -7895059235#
    R3 = 242396853.1:            R4 = -2972611.439
    R5 = 15704.4826:             R6 = -30.16036606
    S1 = 144725228442#:          S2 = 2300535178#
    S3 = 18583304.74:            S4 = 99447.43394
    S5 = 376.9991397:            S6 = 1#
    P1 = 1#:                     P2 = 0.00183105
    P3 = -0.00003516396496:      P4 = 0.000002457520174
    P5 = -0.000000240337019:
    Q1 = 0.04687499995:          Q2 = -0.0002002690873
    Q3 = 0.000008449199096:      Q4 = -0.00000088228987
    Q5 = 0.000000105787412
    If Abs(X) < 8# Then
        Y# = X ^ 2
        AAA# = R1 + Y * (R2 + Y * (R3 + Y * (R4 + Y * (R5 + Y * R6))))
        BBB# = S1 + Y * (S2 + Y * (S3 + Y * (S4 + Y * (S5 + Y * S6))))
        BESSJ1 = X * AAA# / BBB#
    Else
        AX = Abs(X)
        Z = 8# / AX
        Y# = Z ^ 2
        XX = AX - 2.356194491
        AAA# = P1 + Y * (P2 + Y * (P3 + Y * (P4 + Y * P5)))
        BBB# = Q1 + Y * (Q2 + Y * (Q3 + Y * (Q4 + Y * Q5)))
        CCC# = Sqr(0.636619772 / AX)
        BESSJ1 = CCC# * (Cos(XX) * AAA# - Z * Sin(XX) * BBB# * Sgn(X))
    End If
End Function