d4r19.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5565
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5100
   LinkTopic       =   "Form1"
   ScaleHeight     =   5565
   ScaleWidth      =   5100
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3120
      TabIndex        =   0
      Top             =   4800
      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 D4R19
    'Driver for routine BESSY
    Open "D:\VB常用数值算法集\DATA\FNCVAL.DAT" For Input As #1
    Do
      Line Input #1, Text$
      Text$ = Left(Text$, 18)
    Loop While Text$ <> "Bessel Function Yn"
    Line Input #1, NVAL$
    NVAL = Val(NVAL$)
    Print Text$
    Print
    Print "   N      X         Actual         BESSY(N,X)"
    For I = 1 To NVAL
        Line Input #1, DUM$
        N = Val(Mid(DUM$, 1, 6))
        X = Val(Mid(DUM$, 7, 6))
        Value = Val(Mid(DUM$, 13))
        Print Tab(4); Format$(N, "#0");
        Print Tab(10); Format$(X, "#0.0#");
        Print Tab(18); Format$(Value, ".000000E+00");
        Print Tab(34); Format$(BESSY(N, X), ".000000E+00")
    Next I
    Close #1
End Sub
Function BESSY(N, X)
    If N < 2 Then
        Print "bad argument N in BESSY"
        Exit Function
    End If
    TOX = 2# / X
    By = BESSY1(X)
    BYM = BESSY0(X)
    For J = 1 To N - 1
        BYP = J * TOX * By - BYM
        BYM = By
        By = BYP
    Next J
    BESSY = By
End Function
  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# = S1 + y * (S2 + y * (S3 + y * (S4 + y * (S5 + y * (S6 + y * S7)))))
          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 BESSY0(X)
      P1 = 1#
      P2 = -0.001098628627
      P3 = 0.00002734510407
      P4 = -0.000002073370639
      P5 = 2.093887211E-07
      Q1 = -0.01562499995
      Q2 = 0.0001430488765
      Q3 = -0.000006911147651
      Q4 = 7.621095161E-07
      Q5 = -9.34945152E-08
      R1 = -2957821389#
      R2 = 7062834065#
      R3 = -512359803.6
      R4 = 10879881.29
      R5 = -86327.92757
      R6 = 228.4622733
      S1 = 40076544269#
      S2 = 745249964.8
      S3 = 7189466.438
      S4 = 47447.2647
      S5 = 226.1030244
      S6 = 1#
      If 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))))
          BESSY0 = AAA# / BBB# + 0.636619772 * BESSJ0(X) * Log(X)
      Else
          Z = 8# / X
          y# = Z ^ 2
          XX = X - 0.785398164
          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)))
          BESSY0 = 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
Function BESSJ0(X)
    P1# = 1#
    P2# = -0.001098628627
    P3# = 0.00002734510407
    P4# = -0.000002073370639
    P5# = 2.093887211E-07
    Q1# = -0.01562499995
    Q2# = 0.0001430488765
    Q3# = -0.000006911147651
    Q4# = 7.621095161E-07
    Q5# = -9.34945152E-08
    R1# = 57568490574#
    R2# = -13362590354#
    R3# = 651619640.7
    R4# = -11214424.18
    R5# = 77392.33017
    R6# = -184.9052456
    S1# = 57568490411#
    S2# = 1029532985#
    S3# = 9494680.718
    S4# = 59272.64853
    S5# = 267.8532712
    S6# = 1#
    If Abs(X) < 8# Then
       y# = X * X
       BBB# = y# * (R4# + y# * (R5# + y# * R6#))
       AAA# = R1# + y# * (R2# + y# * (R3# + BBB#))
       CCC# = y# * (S3# + y# * (S4# + y# * (S5# + y# * S6#)))
       BESSJ0 = AAA / (S1# + y# * (S2# + CCC#))
    Else
       AX# = Abs(X)
       Z# = 8# / AX#
       y# = Z# * Z#
       XX = AX# - 0.785398164
       CCC# = y# * (P3# + y# * (P4# + y# * P5#))
       AAA# = P1# + y# * (P2# + CCC#)
       DDD# = y# * (Q3# + y# * (Q4# + y# * Q5#))
       EEE# = Z# * Sin(XX) * (Q1# + y# * (Q2# + DDD#))
       BESSJ0 = Sqr(0.636619772 / AX#) * (Cos(XX) * AAA# - EEE#)
    End If
End Function