d10r1.frm

VB数值分析

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7620
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5970
   LinkTopic       =   "Form1"
   ScaleHeight     =   7620
   ScaleWidth      =   5970
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   4680
      TabIndex        =   0
      Top             =   120
      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 D10R1
    'Driver for routine FOUR1
    NN = 32
    NN2 = 2 * NN
    Dim DATA(64), DCMP(64)
    Print Tab(5); "h(t)=real-valued even-function"
    Print Tab(5); "H(n)=H(N-n) and real?"
    For I = 1 To 2 * NN - 1 Step 2
        DATA(I) = 1# / (((I - NN - 1#) / NN) ^ 2 + 1#)
        DATA(I + 1) = 0#
    Next I
    ISIGN = 1
    Call FOUR1(DATA(), NN, ISIGN)
    Call PRNTFT(DATA(), NN2)
    Print Tab(5); "h(t)=imagnary-valued even-function"
    Print Tab(5); "H(n)=H(N-n) and imaginary?"
    For I = 1 To 2 * NN - 1 Step 2
        DATA(I + 1) = 1# / (((I - NN - 1#) / NN) ^ 2 + 1#)
        DATA(I) = 0#
    Next I
    ISIGN = 1
    Call FOUR1(DATA(), NN, ISIGN)
    Call PRNTFT(DATA(), NN2)
    Print Tab(5); "h(t)=imagnary-valued even-function"
    Print Tab(5); "H(n)=H(N-n) and imaginary?"
    For I = 1 To 2 * NN - 1 Step 2
        DATA(I) = (I - NN - 1#) / NN / (((I - NN - 1#) / NN) ^ 2 + 1#)
        DATA(I + 1) = 0#
    Next I
    DATA(1) = 0#
    ISIGN = 1
    Call FOUR1(DATA(), NN, ISIGN)
    Call PRNTFT(DATA(), NN2)
    Print Tab(5); "h(t)=imagnary-valued odd-function"
    Print Tab(5); "H(n)=-H(N-n) and real?"
    For I = 1 To 2 * NN - 1 Step 2
        AAA = (I - NN - 1#)
        DATA(I + 1) = AAA / NN / (((I - NN - 1#) / NN) ^ 2 + 1#)
        DATA(I) = 0#
    Next I
    DATA(2) = 0#
    ISIGN = 1
    Call FOUR1(DATA(), NN, ISIGN)
    Call PRNTFT(DATA(), NN2)
    'Transrorm, inverse-transform test
    For I = 1 To 2 * NN - 1 Step 2
        DATA(I) = 1# / ((0.5 * (I - NN - 1) / NN) ^ 2 + 1#)
        DCMP(I) = DATA(I)
        DATA(I + 1) = (0.25 * (I - NN - 1) / NN)
        DATA(I + 1) = DATA(I + 1) * Exp(-(0.5 * (I - NN - 1) / NN) ^ 2)
        DCMP(I + 1) = DATA(I + 1)
    Next I
    ISIGN = 1
    Call FOUR1(DATA(), NN, ISIGN)
    ISIGN = -1
    Call FOUR1(DATA(), NN, ISIGN)
    Print Tab(5); "FORuble Fourier Transform:   Original Data:"
    Print Tab(5); "k     Real h(k)   Imag h(k)    Real h(k)   Imag h(k)"
    For I = 1 To NN Step 2
        J = (I + 1) / 2
        Print Tab(5); Format$(J, "##");
        Print Tab(12); Format$(DCMP(I), "##.#####0");
        Print Tab(25); Format$(DCMP(I + 1), "##.#####0");
        Print Tab(38); Format$(DATA(I) / NN, "##.#####0");
        Print Tab(51); Format$(DATA(I + 1) / NN, "##.#####0")
    Next I
End Sub
Sub PRNTFT(DATA(), NN2)
    Print Tab(5); "n      Real H(n)    Imag H(n)    Real H(N-n)  Imag H(N-n)"
    Print Tab(5); Format$(0, "0");
    Print Tab(12); Format$(DATA(1), "##.#####0");
    Print Tab(25); Format$(DATA(2), "##.#####0");
    Print Tab(38); Format$(DATA(1), "##.#####0");
    Print Tab(51); Format$(DATA(2), "##.#####0")
    For N = 3 To (NN2 / 2) + 1 Step 2
        M = (N - 1) / 2
        MM = NN2 + 2 - N
        Print Tab(5); Format$(M, "##");
        Print Tab(12); Format$(DATA(N), "##.#####0");
        Print Tab(25); Format$(DATA(N + 1), "##.#####0");
        Print Tab(38); Format$(DATA(MM), "##.#####0");
        Print Tab(51); Format$(DATA(MM + 1), "##.#####0")
    Next N
End Sub
Sub FOUR1(DATA(), NN, ISIGN)
    N = 2 * NN
    J = 1
    For I = 1 To N Step 2
        If J > I Then
            TEMPR = DATA(J)
            TEMPI = DATA(J + 1)
            DATA(J) = DATA(I)
            DATA(J + 1) = DATA(I + 1)
            DATA(I) = TEMPR
            DATA(I + 1) = TEMPI
        End If
        M = N / 2
        While M >= 2 And J > M
            J = J - M
            M = M / 2
        Wend
        J = J + M
    Next I
    MMAX = 2
    While N > MMAX
        ISTEP = 2 * MMAX
        THETA = 6.28318530717959 / (ISIGN * MMAX)
        WPR = -2# * Sin(0.5 * THETA) ^ 2
        WPI = Sin(THETA)
        WR = 1#
        WI = 0#
        For M = 1 To MMAX Step 2
            For I = M To N Step ISTEP
                J = I + MMAX
                TEMPR = CSng(WR) * DATA(J) - CSng(WI) * DATA(J + 1)
                TEMPI = CSng(WR) * DATA(J + 1) + CSng(WI) * DATA(J)
                DATA(J) = DATA(I) - TEMPR
                DATA(J + 1) = DATA(I + 1) - TEMPI
                DATA(I) = DATA(I) + TEMPR
                DATA(I + 1) = DATA(I + 1) + TEMPI
            Next I
            WTEMP = WR
            WR = WR * WPR - WI * WPI + WR
            WI = WI * WPR + WTEMP * WPI + WI
        Next M
        MMAX = ISTEP
    Wend
End Sub