d4r18.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5190
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4155
   LinkTopic       =   "Form1"
   ScaleHeight     =   5190
   ScaleWidth      =   4155
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   2280
      TabIndex        =   0
      Top             =   4200
      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 D4R18
    'Driver for routine BESSY1
    Open "D:\VB常用数值算法集\DATA\FNCVAL.DAT" For Input As #1
    Do
      Line Input #1, Text$
    Loop While Text$ <> "Bessel Function Y1"
    Line Input #1, NVAL$
    NVAL = Val(NVAL$)
    Print Text$
    Print
    Print "    X       Actual       BESSY1(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$(BESSY1(X), "##.0000000")
    Next I
    Close #1
End Sub
Function BESSY1(X)
    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:
    R1 = -4900604943000#:        R2 = 1275274390000#:
    R3 = -51534381390#:          R4 = 734926455.1
    R5 = -4237922.726:           R6 = 8511.937935
    S1 = 24995805700000#:        S2 = 424441966400#
    S3 = 3733650367#:            S4 = 22459040.02
    S5 = 102042.605:             S6 = 354.9632885
    S7 = 1#
    If X < 8# Then
        Y# = X ^ 2
        AAA# = R1 + Y * (R2 + Y * (R3 + Y * (R4 + Y * (R5 + Y * R6))))
        BBB# = S4 + Y * (S5 + Y * (S6 + Y * S7))
        BBB# = S1 + Y * (S2 + Y * (S3 + Y * BBB#))
        CCC# = BESSJ1(X) * Log(X) - 1# / X
        BESSY1 = X * AAA# / BBB# + 0.636619772 * CCC#
    Else
        Z = 8# / X
        Y# = Z ^ 2
        XX = X - 2.356194491
        AAA# = Sqr(0.636619772 / X)
        BBB# = P1 + Y * (P2 + Y * (P3 + Y * (P4 + Y * P5)))
        CCC# = Q1 + Y * (Q2 + Y * (Q3 + Y * (Q4 + Y * Q5)))
        BESSY1 = AAA# * (Sin(XX) * BBB# + Z * Cos(XX) * CCC#)
    End If
End Function
   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