d10r3.frm

VB数值分析

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   8415
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6990
   LinkTopic       =   "Form1"
   ScaleHeight     =   8415
   ScaleWidth      =   6990
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   5520
      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 D10R3
    'Driver for routine REALFT
    EPS = 0.001
    NP = 32
    NPP2 = NP + 2
    Width1 = 50#
    PI = 3.14159
    Dim DATA(34), SIZE1(32)
    N = NP / 2
    Print Tab(5); "Period of sinusoid in channels (2-";
    Print Format$(NP, "##"); "; or 0 to stop)"
    PER = 5
    If PER <= 0# Then Exit Sub
    For I = 1 To NP
        DATA(I) = Cos(2# * PI * (I - 1) / PER)
    Next I
    Call REALFT(DATA(), N, 1)
    BIG = -10000000000#
    For I = 1 To N
        SIZE1(I) = Sqr(DATA(2 * I - 1) ^ 2 + DATA(2 * I) ^ 2)
        If I = 1 Then SIZE1(I) = DATA(I)
        If SIZE1(I) > BIG Then BIG = SIZE1(I)
    Next I
    SCAL1 = Width1 / BIG
    For I = 1 To N
        NLIM = SCAL1 * SIZE1(I) + EPS
        Form1.Print Tab(5); Format$(I, "##");
        For J = 1 To NLIM + 1
            Print "*";
        Next J
    Next I
    Call REALFT(DATA(), N, -1)
    BIG = -10000000000#
    SMALL = 10000000000#
    For I = 1 To NP
        If DATA(I) < SMALL Then SMALL = DATA(I)
        If DATA(I) > BIG Then BIG = DATA(I)
    Next I
    SCAL1 = Width1 / (BIG - SMALL)
    For I = 1 To NP
        NLIM = Int(SCAL1 * (DATA(I) - SMALL) + EPS)
        Print Tab(5); Format$(I, "##");
        For J = 1 To NLIM + 1
            Print "*";
        Next J
    Next I
End Sub
Sub REALFT(DATA(), N, ISIGN)
    THETA = 6.28318530717959 / 2# / N
    C1 = 0.5
    If ISIGN = 1 Then
        C2 = -0.5
        Call FOUR1(DATA(), N, 1)
    Else
        C2 = 0.5
        THETA = -THETA
    End If
    WPR = -2# * Sin(0.5 * THETA) ^ 2
    WPI = Sin(THETA)
    WR = 1# + WPR
    WI = WPI
    N2P3 = 2 * N + 3
    For I = 2 To N / 2 + 1
        I1 = 2 * I - 1
        I2 = I1 + 1
        I3 = N2P3 - I2
        I4 = I3 + 1
        WRS = CSng(WR)
        WIS = CSng(WI)
        H1R = C1 * (DATA(I1) + DATA(I3))
        H1I = C1 * (DATA(I2) - DATA(I4))
        H2R = -C2 * (DATA(I2) + DATA(I4))
        H2I = C2 * (DATA(I1) - DATA(I3))
        DATA(I1) = H1R + WRS * H2R - WIS * H2I
        DATA(I2) = H1I + WRS * H2I + WIS * H2R
        DATA(I3) = H1R - WRS * H2R + WIS * H2I
        DATA(I4) = -H1I + WRS * H2I + WIS * H2R
        WTEMP = WR
        WR = WR * WPR - WI * WRI + WR
        WI = WI * WPR + WTEMP * WPI + WI
    Next I
    If ISIGN = 1 Then
        H1R = DATA(1)
        DATA(1) = H1R + DATA(2)
        DATA(2) = H1R - DATA(2)
    Else
        H1R = DATA(1)
        DATA(1) = C1 * (H1R + DATA(2))
        DATA(2) = C1 * (H1R - DATA(2))
        Call FOUR1(DATA(), N, -1)
    End If
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