d10r8.frm

VB数值分析

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3705
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6075
   LinkTopic       =   "Form1"
   ScaleHeight     =   3705
   ScaleWidth      =   6075
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4320
      TabIndex        =   0
      Top             =   2880
      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 D10R8
    'Driver for routine FOURN
    NDIM = 3
    NDAT = 1024
    Dim NN(3), Data(1024)
    For I = 1 To NDIM
        NN(I) = 2 * (2 ^ I)
    Next I
    For I = 1 To NN(3)
        For J = 1 To NN(2)
            For K = 1 To NN(1)
              L = K + (J - 1) * NN(1) + (I - 1) * NN(2) * NN(1)
              LL = 2 * L - 1
              Data(LL) = LL
              Data(LL + 1) = LL + 1
            Next K
        Next J
    Next I
    ISIGN = 1
    Call FOURN(Data(), NN(), NDIM, ISIGN)
    ISIGN = -1
    Print
    Print Tab(5); "FORuble 3-dimensional Transform"
    Print
    Print Tab(5); "FORuble Trabsf.    Original Data      Ratio"
    Print
    Print Tab(5); " Real        Imag.       Real     Imag.    Real     Imag."
    Call FOURN(Data(), NN(), NDIM, ISIGN)
    For I = 1 To 4
        J = 2 * I
        K = 2 * J
        L = K + (J - 1) * NN(1) + (I - 1) * NN(2) * NN(1)
        LL = 2 * L - 1
        Print Tab(5); Format$(Data(LL), "######.#0");
        Print Tab(17); Format$(Data(LL + 1), "######.#0");
        Print Tab(29); Format$(LL, "###.#0");
        Print Tab(39); Format$(LL + 1, "###.##");
        Print Tab(47); Format$(Data(LL) / LL, "###.#0");
        Print Tab(57); Format$(Data(LL + 1) / (LL + 1), "###.#0")
    Next I
    Print
    Print Tab(5); "The product of transform lengths is: ";
    Print NN(1) * NN(2) * NN(3)
End Sub
Sub FOURN(Data(), NN(), NDIM, ISIGN)
    NTOT = 1
    For IDIM = 1 To NDIM
        NTOT = NTOT * NN(IDIM)
    Next IDIM
    NPREV = 1
    For IDIM = 1 To NDIM
        N = NN(IDIM)
        NREM = NTOT / (N * NPREV)
        IP1 = 2 * NPREV
        IP2 = IP1 * N
        IP3 = IP2 * NREM
        I2REV = 1
        For I2 = 1 To IP2 Step IP1
            If I2 < I2REV Then
                For I1 = I2 To I2 + IP1 - 2 Step 2
                    For I3 = I1 To IP3 Step IP2
                        I3REV = I2REV + I3 - I2
                        TEMPR = Data(I3)
                        TEMPI = Data(I3 + 1)
                        Data(I3) = Data(I3REV)
                        Data(I3 + 1) = Data(I3REV + 1)
                        Data(I3REV) = TEMPR
                        Data(I3REV + 1) = TEMPI
                    Next I3
                Next I1
            End If
            IBit = IP2 / 2
1           If IBit >= IP1 And I2REV > IBit Then
                I2REV = I2REV - IBit
                IBit = IBit / 2
                GoTo 1
            End If
            I2REV = I2REV + IBit
        Next I2
        IFP1 = IP1
2       If IFP1 < IP2 Then
            IFP2 = 2 * IFP1
            THETA = ISIGN * 6.28318530717959 / (IFP2 / IP1)
            WPR = -2# * (Sin(0.5 * THETA)) ^ 2
            WPI = Sin(THETA)
            WR = 1#
            WI = 0#
            For I3 = 1 To IFP1 Step IP1
              For I1 = I3 To I3 + IP1 - 2 Step 2
                For I2 = I1 To IP3 Step IFP2
                  K1 = I2
                  K2 = K1 + IFP1
                  TEMPR = CSng(WR) * Data(K2) - CSng(WI) * Data(K2 + 1)
                  TEMPI = CSng(WR) * Data(K2 + 1) + CSng(WI) * Data(K2)
                  Data(K2) = Data(K1) - TEMPR
                  Data(K2 + 1) = Data(K1 + 1) - TEMPI
                  Data(K1) = Data(K1) + TEMPR
                  Data(K1 + 1) = Data(K1 + 1) + TEMPI
                Next I2
              Next I1
              WTEMP = WR
              WR = WR * WPR - WI * WPI + WR
              WI = WI * WPR + WTEMP * WPI + WI
            Next I3
            IFP1 = IFP2
            GoTo 2
        End If
        NPREV = N * NPREV
    Next IDIM
End Sub