d6r6.frm

常用的数值算法的VB程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   5730
   ClientLeft      =   2865
   ClientTop       =   1545
   ClientWidth     =   6120
   LinkTopic       =   "Form1"
   ScaleHeight     =   5730
   ScaleWidth      =   6120
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4320
      TabIndex        =   0
      Top             =   4920
      Width           =   1095
   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 D6R6
     'Driver for routine GASDEV
     Dim TEXT(50) As String
     N = 20
     NP1 = N + 1
     NOVER2 = N / 2
     NPTS = 10000
     ISCAL = 400
     LLEN = 50
     Dim DIST(21)
     IDUM& = -13
     For J = 1 To NP1
         DIST(J) = 0#
     Next J
     For I = 1 To NPTS
         J = CInt(0.25 * N * GASDEV(IDUM&)) + NOVER2 + 1
         If (J >= 1) And (J <= NP1) Then DIST(J) = DIST(J) + 1
     Next I
     Print
     Print Tab(5); "Normally distributed deviate of  "; NPTS; " points"
     Print
     Print Tab(5); " x         p(x)       graph:"
     For J = 1 To NP1
         DIST(J) = DIST(J) / NPTS
         For K = 1 To 50
             TEXT(K) = ""
         Next K
         KLIM = CInt(ISCAL * DIST(J))
         If KLIM > LLEN Then KLIM = LLEN
         For K = 1 To KLIM
             TEXT(K) = "*"
         Next K
         X = J / (0.25 * N)
         Print Tab(5); Format$(X, "#.#0");
         Print Tab(15); Format$(DIST(J), "0.###0");
         Print Tab(22); "     ";
         For K = 1 To 50
             Print TEXT(K);
         Next K
         Print
    Next J
End Sub
Function GASDEV(IDUM&)
    Static ISET, GSET
    If ISET = 0 Then
      Do
        V1 = 2# * RAN1(IDUM&) - 1#
        V2 = 2# * RAN1(IDUM&) - 1#
        R = V1 ^ 2 + V2 ^ 2
      Loop While R >= 1# Or R = 0
      FAC = Sqr(-2# * Log(R) / R)
      GSET = V1 * FAC
      GASDEV = V2 * FAC
      ISET = 1
    Else
      GASDEV = GSET
      ISET = 0
    End If
End Function
Static Function RAN1(IDUM&)
    Dim R(97)
    M1& = 259200: IA1& = 7141: IC1& = 54773: RM1 = 0.0000038580247
    M2& = 134456: IA2& = 8121: IC2& = 28411: RM2 = 0.0000074373773
    M3& = 243000: IA3& = 4561: IC3& = 51349
    If IDUM& < 0 Or IFF = 0 Then
        IFF = 1
        IX1& = (IC1& - IDUM&) Mod M1&
        IX1& = (IA1& * IX1& + IC1&) Mod M1&
        IX2& = IX1& Mod M2&
        IX1& = (IA1& * IX1& + IC1&) Mod M1&
        IX3& = IX1& Mod M3&
        For J = 1 To 97
            IX1& = (IA1& * IX1& + IC1&) Mod M1&
            IX2& = (IA2& * IX2& + IC2&) Mod M2&
            R(J) = (CSng(IX1&) + CSng(IX2&) * RM2) * RM1
        Next J
        IDUM& = 1
    End If
    IX1& = (IA1& * IX1& + IC1&) Mod M1&
    IX2& = (IA2& * IX2& + IC2&) Mod M2&
    IX3& = (IA3& * IX3& + IC3&) Mod M3&
    J = 1 + Int((97 * IX3&) / M3&)
    If J > 97 Or J < 1 Then Print "Abnormal exit": Exit Function
    RAN1 = R(J)
    R(J) = (CSng(IX1&) + CSng(IX2&) * RM2) * RM1
End Function