convlv.txt

用VB实现的傅立叶变换谱方法 包括复数据快速傅立叶变换算法、实数据快速傅立叶变换算法1、实数据快速傅立叶变换算法2、快速正弦变换和余弦变换等

Sub CONVLV(DATA(), N, RESPNS(), M, ISIGN, ANS())
    Dim FFT(32)
    For I = 1 To CInt(M - 1) / 2
        RESPNS(N + 1 - I) = RESPNS(M + 1 - I)
    Next I
    For I = CInt(M + 3) / 2 To N - CInt(M - 1) / 2
        RESPNS(I) = 0#
    Next I
    Call TWOFFT(DATA(), RESPNS(), FFT(), ANS(), N)
    NO2 = CInt(N / 2)
    For I = 1 To NO2 + 1
        If ISIGN = 1 Then
          DUM = ANS(2 * I - 1)
          DUM1 = FFT(2 * I - 1) * DUM - FFT(2 * I) * ANS(2 * I)
          ANS(2 * I - 1) = DUM1 / NO2
          DUM2 = FFT(2 * I - 1) * ANS(2 * I) + FFT(2 * I) * DUM
          ANS(2 * I) = DUM2 / NO2
        ElseIf ISIGN = -1 Then
          If DUM = 0# And ANS(2 * I) = 0 Then
            Print "deconvolving at a response zero"
            Exit Sub
          End If
          ANS1 = FFT(2 * I - 1) * DUM + FFT(2 * I) * ANS(2 * I)
          DUM1 = DUM * DUM + ANS(2 * I) * ANS(2 * I)
          ANS(2 * I - 1) = ANS1 / DUM1 / NO2
          ANS1 = FFT(2 * I) * DUM - FFT(2 * I - 1) * ANS(2 * I)
          DUM2 = DUM * DUM + ANS(2 * I) * ANS(2 * I)
          ANS(2 * I) = ANS1 / DUM2 / NO2
        Else
          Print " no meaning for ISIGN"
        End If
    Next I
    ANS(2) = ANS(2 * NO2 + 1)
    Call REALFT(ANS(), NO2, -1)
    Erase FFT
End Sub