End of file
Contents
Index



F 8.1.5.3 Complex Discrete Fourier Transformation


      SUBROUTINE RFFT (ITAU, Y, ID)
C
C*****************************************************************
C                                                                *
C     For ID = 0 this program determines the discrete Fourier    *
C     coefficients                                               *
C          A(0), ... , A(M/2) and B(1), ... , B(M/2-1)           *
C     for M=2**ITAU given real function values Y(0), ... , Y(M-1)*
C     of the associated discrete Fourier series                  *
C                                                                *
C          A(0) + (SUM K=1 to M/2-1)                             *
C                     A(K)*COS(K*OMEGA*X) + B(K)*SIN(K*OMEGA*X)  *
C               +  A(M/2)*COS(M/2*OMEGA*X)                       *
C                                                                *
C     Here OMEGA = 2*PI/L for the period L.                      *
C     For ID = 1, it performs                                    *
C     the inverse transformation. Both transformations are       *
C     executed via a fast Fourier-transformation for the radix 2.*
C                                                                *
C                                                                *
C  INPUT PARAMETERS:                                             *
C  =================                                             *
C  ITAU: the number of function values is M=2**ITAU.             *
C        ITAU has to be >= 2.                                    *
C  Y   : real M-vector Y(0), Y(1), ... , Y(M-1);                 *
C        depending on ID, Y has to be set up as follows:         *
C         If ID=0 then Y contains the function values,           *
C         If ID=1, then Y contains the discrete Fourier          *
C                  coefficients labelled as follows:             *
C                      Y(0)=A(0)                                 *
C                      Y(K)=A((K+1)/2), K=1, 3, ... , M-1,       *
C                      Y(K)=B(K/2)    , K=2, 4, ... , M-2,       *
C                   in the following order:                      *
C                      A(0), A(1), B(1), A(2), B(2), ...         *
C  ID  : controls the direction of the performed transformation  *
C           ID=0: compute the discrete Fourier coefficients      *
C           ID=1: compute the function values                    *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  Y   :   real M-vector Y(0), Y(1), ... , Y(M-1);               *
C          depending on ID, the following values are returned:   *
C           If ID=0: The vector contains the discrete Fourier    *
C                    coefficients as follows:                    *
C                      A(0)=Y(0)                                 *
C                      A(K)=Y(2*K-1), K=1, ... , M/2,            *
C                      B(K)=Y(2*K)  , K=1, ... , M/2-1,          *
C                  in the following order:                       *
C                      A(0), A(1), B(1), A(2), B(2), ...         *
C           If ID=1: the function values are returned            *
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  subroutines required: none                                    *
C                                                                *
C                                                                *
C  sources : Niederdrenk, K., see [NIED84].                      *
C                                                                *
C*****************************************************************
C                                                                *
C  author   : Klaus Niederdrenk                                  *
C  date     : 02.14.1984                                         *
C  source   : FORTRAN 77                                         *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER ITAU, SIGMA
      DIMENSION Y(0:2**ITAU-1)
C
      M=2**ITAU
      MD2=M/2
      MD4=MD2/2
      FACTOR=1.0D0/DBLE(MD2)
      PI=4.0D0*DATAN(1.0D0)
      ARGMD2=2.0D0*PI*FACTOR
      ARGM=0.5D0*ARGMD2
      VZ=DBLE(2*ID-1)
      IF (ID .EQ. 1) FACTOR=1.0D0
C
C*****************************************************************
C     combining the real data for an FFT of halved length if     *
C     ID = 1                                                     *
C*****************************************************************
C
C****  URR, URI  : real and imaginary parts of      ****
C****              the M-th roots of unity          ****
C**** EPSR, EPSI : real and imaginary parts of      ****
C****              (M-th root of unity)**K          ****
\hbox{\JDhspace\verb`
      IF (ID .EQ. 1) THEN
        YSVE=Y(1)
        Y(1)=Y(0)-Y(M-1)
        Y(0)=Y(0)+Y(M-1)
        URR=DCOS(ARGM)
        URI=DSIN(ARGM)
        EPSR=1.0D0
        EPSI=0.0D0
        DO 10 K = 1, MD4-1
          STORE=EPSR
          EPSR=STORE*URR-EPSI*URI
          EPSI=STORE*URI+EPSI*URR
          DMY1=0.5D0*(EPSR*(YSVE-Y(M-2*K-1))+EPSI*(Y(2*K)+Y(M-2*K)))
          DMY2=0.5D0*(EPSI*(YSVE-Y(M-2*K-1))-EPSR*(Y(2*K)+Y(M-2*K)))
          DMY3=0.5D0*(YSVE+Y(M-2*K-1))
          DMY4=0.5D0*(Y(2*K)-Y(M-2*K))
          YSVE=Y(2*K+1)
          Y(2*K)=DMY3-DMY2
          Y(2*K+1)=DMY1-DMY4
          Y(M-2*K)=DMY2+DMY3
          Y(M-2*K+1)=DMY1+DMY4
  10    CONTINUE
        Y(MD2+1)=Y(MD2)
        Y(MD2)=YSVE
      ENDIF
C
C*****************************************************************
C     relabelling with the bit-reversing function                *
C     (while normalizing, if ID=0)                               *
C*****************************************************************
C
      DO 30 J = 0, MD2-1
      K=J
      SIGMA=0
      DO 20 N = 1, ITAU-1
        KD2=K/2
        SIGMA=2*SIGMA+K-2*KD2
        K=KD2
  20  CONTINUE
      IF (SIGMA .LT. J) GOTO 30
      UR=Y(2*J)
      UI=Y(2*J+1)
      Y(2*J)=Y(2*SIGMA)*FACTOR
      Y(2*J+1)=Y(2*SIGMA+1)*FACTOR
      Y(2*SIGMA)=UR*FACTOR
      Y(2*SIGMA+1)=UI*FACTOR
  30  CONTINUE
C
C*****************************************************************
C      execution of the FFT of half length                       *
C*****************************************************************
C
C****   MIN N   = 2**( ITAU-1 - N )                     ****
C****  N MIN 1  = 2**( N - 1 )                          ****
C****  N MIN 0  = 2**( N )                              ****
C****   RR, RI  = real and imaginary parts of           ****
C****             (M/2 -th root of unity)**(2**MINN)    ****
C**** EPSR,EPSI = real and imaginary parts of           ****
C****             (M/2 -th root of unity)**(L*2**MINN)  ****
C
      MINN=MD2
      NMIN1=1
      DO 130 N = 1, ITAU-1
        MINN=MINN/2
        NMIN0=NMIN1+NMIN1
        ARG=ARGMD2*DBLE(MINN)
        RR=DCOS(ARG)
        RI=VZ*DSIN(ARG)
        EPSR=1.0D0
        EPSI=0.0D0
        DO 120 L = 0, NMIN1-1
          DO 110 J = 0, MD2-NMIN0, NMIN0
            UR=Y(2*(J+L)+NMIN0)*EPSR-Y(2*(J+L)+NMIN0+1)*EPSI
            UI=Y(2*(J+L)+NMIN0)*EPSI+Y(2*(J+L)+NMIN0+1)*EPSR
            Y(2*(J+L)+NMIN0)=Y(2*(J+L))-UR
            Y(2*(J+L)+NMIN0+1)=Y(2*(J+L)+1)-UI
            Y(2*(J+L))=Y(2*(J+L))+UR
            Y(2*(J+L)+1)=Y(2*(J+L)+1)+UI
  110     CONTINUE
          STORE=EPSR
          EPSR=STORE*RR-EPSI*RI
          EPSI=STORE*RI+EPSI*RR
  120   CONTINUE
        NMIN1=NMIN0
  130 CONTINUE
C
C*****************************************************************
C     separating the transformed data, if ID=0                   *
C*****************************************************************
C
C****  URR, URI  : real and imaginary parts of    ****
C****              the M-th root of unity         ****
C**** EPSR, EPSI : real and imaginary parts of    ****
C****              (M-th root of unity)**K        ****
C
      IF (ID .EQ. 0) THEN
        YSVE=Y(M-1)
        Y(M-1)=0.5D0*(Y(0)-Y(1))
        Y(0)=0.5D0*(Y(0)+Y(1))
        URR=DCOS(ARGM)
        URI=-DSIN(ARGM)
        EPSR=1.0D0
        EPSI=0.0D0
        DO 150 K = 1, MD4-1
          STORE=EPSR
          EPSR=STORE*URR-EPSI*URI
          EPSI=STORE*URI+EPSI*URR
          DMY1=0.5D0*(EPSI*(Y(2*K)-Y(M-2*K))+EPSR*(Y(2*K+1)+YSVE))
          DMY2=0.5D0*(EPSR*(Y(2*K)-Y(M-2*K))-EPSI*(Y(2*K+1)+YSVE))
          DMY3=0.5D0*(Y(2*K)+Y(M-2*K))
          DMY4=0.5D0*(Y(2*K+1)-YSVE)
          YSVE=Y(M-2*K-1)
          Y(2*K-1)=DMY1+DMY3
          Y(2*K)=DMY2-DMY4
          Y(M-2*K-1)=DMY3-DMY1
          Y(M-2*K)=DMY2+DMY4
  150   CONTINUE
        Y(MD2-1)=Y(MD2)
        Y(MD2)=YSVE
      ENDIF
C
      R E T U R N
      END


Begin of file
Contents
Index