End of file
Contents
Index

       SUBROUTINE FDICHT (M, FRE, FIM, P, TETA)
C
C*****************************************************************
C                                                                *
C  This program  computes the values of the trigonometric        *
C  interpolating polynomial (i.e. the discrete partial Fourier   *
C  sum) using the Fast Fourier Transform (FFT) for a given set   *
C  of function values F(0), F(1), ... , F(M-1) of a P-periodic   *
C  function F for equidistant nodes t(0), t(1), ... , t(M-1),    * 
C  t(j) = j*P/M  at a set of shifted nodes t(j) + TETA  for      *
C  j = 0, 1, ... , M-1.  ("Increase of number of nodes")         *
C  The double precision vectors  FRE  and  FIM  contain the real *
C  and imaginary parts of the values for F.                      *
C                                                                *
C                                                                *
C  INPUT PARAMETER:                                              *
C  ================                                              *
C  M        : Number of original nodes.                          *
C             If M is a power of two ( M = 2**ITAU  for a        *
C             positive integer ITAU ), we make use of the        *
C             subroutineso  FFT, which runs for all values of M. *
C             If M  is not a power of two, then we call on FFTB, * 
C             which limits the available size for its auxiliary  *
C             vectors F1RE, F1IM, GRE, GIM  to  1 <= M <= 1366.  *
C             For larger M, the dimension statement inside FFTB  *
C             must be amended as indicated there.                *
C  FRE, FIM : DOUBLE PRECISION vectors for the real and          *
C             imaginary parts for M functional values of F.      * 
C  P        : Period interval for F.                             *
C  TETA     : Shift parameter: the newly computed values         *
C             correspond to arguments shifted by TETA.           *
C                                                                *
C                                                                *
C  OUTPUT PARAMETERS:                                            *
C  ==================                                            *
C  FRE, FIM : DOUBLE PRECISION vectors;                          *
C             FRE(j) and FIM(j) are the real and imaginary parts *
C             of  F(j)  of the trigonometric interpolating       *
C             polynom at the equidistant nodes                   *
C                 tneu(j) = t(j) + TETA = j*P/M + TETA           *
C             for   j = 0, 1, ... , M-1 .                        * 
C                                                                *
C----------------------------------------------------------------*
C                                                                *
C  Subroutines used: FFT or FFTB                                 *
C                                                                *
C*****************************************************************
C                                                                *
C  Author      : Klaus Niederdrenk                               *
C  Date        : 06.30.1994                                      *
C  Source code : FORTRAN 77                                      *
C                                                                *
C*****************************************************************
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      INTEGER M, ITAU
      DIMENSION FRE(0:M-1), FIM(0:M-1)
      LOGICAL POT2
C
C     Complex multiplication : Real part
C
      CMLR(AR,AI,BR,BI)=AR*BR-AI*BI
C
C     Complex multiplication : Imaginary part
C
      CMLI(AR,AI,BR,BI)=AR*BI+AI*BR
C
C     Check whether M is a power of two     
C
      ITAU=NINT(LOG(REAL(M))/LOG(2.0)) 
      IF(2**ITAU .EQ. M) THEN
        POT2=.TRUE. 
      ELSE  
        POT2=.FALSE.
      ENDIF
C
C****************************************************************
C     Determine discrete Fourier transformation                 *
C****************************************************************
C
      IF( POT2 ) THEN
        CALL FFT(ITAU,FRE,FIM,0)
      ELSE
        CALL FFTB(M,FRE,FIM,0)
      ENDIF
C
C****************************************************************
C     Evaluate the discrete Fourier transformation for the      * 
C     shifted nodes                                             *
C****************************************************************
C
      PI=4.0D0*ATAN(1.0D0)
      FAKTOR=2.0D0*PI*TETA/P
      TETPI=DBLE(-M/2)*FAKTOR
      EKR=COS(TETPI)
      EKI=SIN(TETPI)
      HR=CMLR(FRE(M/2),FIM(M/2),EKR,EKI)
      HI=CMLI(FRE(M/2),FIM(M/2),EKR,EKI)
      DO 10 K = -(M-1)/2, -1
         TETPI=DBLE(K)*FAKTOR
         EKR=COS(TETPI)
         EKI=SIN(TETPI)
         H       =CMLR(FRE(K+M),FIM(K+M),EKR,EKI)
         FIM(K+M)=CMLI(FRE(K+M),FIM(K+M),EKR,EKI)
         FRE(K+M)=H
         H       =CMLR(FRE(-K),FIM(-K),EKR,-EKI)
         FIM(-K) =CMLI(FRE(-K),FIM(-K),EKR,-EKI)
         FRE(-K) =H
  10  CONTINUE
      FRE(M/2)=HR
      FIM(M/2)=HI
C
C****************************************************************
C     Determine functional values                               *
C****************************************************************
C
      IF( POT2 ) THEN
        CALL FFT(ITAU,FRE,FIM,1)
      ELSE
        CALL FFTB(M,FRE,FIM,1)
      ENDIF
      RETURN
      END


Begin of file
Contents
Index