d11r2.frm

方程组的矩阵解法

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4305
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6300
   LinkTopic       =   "Form1"
   ScaleHeight     =   4305
   ScaleWidth      =   6300
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4560
      TabIndex        =   0
      Top             =   3720
      Width           =   1215
   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 D11R2
    'Driver for routine MDIAN1
    NPTS = 50
    Dim DATA(50)
    IDUM = -5
    For I = 1 To NPTS
        DATA(I) = GASDEV(IDUM)
    Next I
    Call MDIAN1(DATA(), NPTS, XMED)
    Print
    Print Tab(5); "Gaussian distrib., zero mean, unit variance"
    Print
    Print Tab(5); "Median of data set is   "; Format$(XMED, "###.######")
    Print
    Print Tab(5); "Sorted data"
    Print
    For I = 1 To 10
        J = (I - 1) * 5
        Print Tab(5); Format$(DATA(J + 1), "#.#####0");
        Print Tab(18); Format$(DATA(J + 2), "#.#####0");
        Print Tab(31); Format$(DATA(J + 3), "#.#####0");
        Print Tab(44); Format$(DATA(J + 4), "#.#####0");
        Print Tab(57); Format$(DATA(J + 5), "#.#####0")
    Next I
End Sub
Sub MDIAN1(X(), N, XMED)
    Call SORT(N, X())
    N2 = N / 2
    If 2 * N2 = N Then
        XMED = 0.5 * (X(N2) + X(N2 + 1))
    Else
        XMED = X(N2 + 1)
    End If
End Sub
   Sub SORT(N, RA())
      L = N / 2 + 1
      IR = N
10    If L > 1 Then
          L = L - 1
          RRA = RA(L)
      Else
          RRA = RA(IR)
          RA(IR) = RA(1)
          IR = IR - 1
          If IR = 1 Then
              RA(1) = RRA
              Exit Sub
          End If
      End If
      I = L
      J = L + L
20    If J <= IR Then
          If J < IR Then
              If RA(J) < RA(J + 1) Then J = J + 1
          End If
          If RRA < RA(J) Then
              RA(I) = RA(J)
              I = J
              J = J + J
          Else
              J = IR + 1
          End If
          GoTo 20
      End If
      RA(I) = RRA
      GoTo 10
End Sub
   Function GASDEV(IDUM)
      Static ISET, GSET
      If ISET = 0 Then
        Do
          Randomize
          V1 = 2# * Rnd - 1#
          V2 = 2# * Rnd - 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