sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/fftr.ft

   1 C       FFTR.FT   FFT-V4A   4/22/76
   2
   3         SUBROUTINE FFTR (A,N,DIR,SGNEX)
   4
   5 C-------ZUSATZPROGRAMM ZUR FFT FUER 2**N REELLE DATEN
   6 C       A = IN- UND OUTPUTARRAY, LAENGE N+1, KOMPLEX (A,B)
   7 C       A(1),...,A(N) ENTHALTEN DIE 2*N REELLEN DATEN
   8 C       VORWAERTS   CALL FFT
   9 C                   CALL REALTR  MIT SGNEXP=+1.
  10 C       RUECKWAERTS CALL REALTR
  11 C                   CALL FFT     MIT SGNEXP=-1.
  12 C-------(DAZU IN EINER RICHTUNG MIT 1/N NORMIEREN)
  13
  14         DIMENSION A(1)
  15         NH=N+1
  16         NK=2*NH
  17         SD=3.14159265/FLOAT(N)
  18         CD=2.*SIN(.5*SD)**2
  19         SD=SIN(SD)*SGNEX
  20         SN=0.
  21         CN=DIR
  22         IF (DIR.LT.0.) GOTO 10
  23         A(NK-1)=A(1)
  24         A(NK)=A(2)
  25 10      DO 20 J=1,NH,2
  26         K=NK-J
  27         J1=J+1
  28         K1=K+1
  29         AA=A(J)+A(K)
  30         AB=A(J)-A(K)
  31         BA=A(J1)+A(K1)
  32         BB=A(J1)-A(K1)
  33         RE=CN*BA+SN*AB
  34         CIM=SN*BA-CN*AB
  35         A(J)=(AA+RE)*.5
  36         A(K)=(AA-RE)*.5
  37         A(J1)=(CIM+BB)*.5
  38         A(K1)=(CIM-BB)*.5
  39         AA=CN-(CD*CN+SD*SN)
  40         SN=(SD*CN-CD*SN)+SN
  41 C       THE FOLLOWING THREE STATMENTS COMPENSATE FOR TRUNCATION
  42 C       ERROR. IF ROUNDED ARITHMETIC IS USED, SUBSTITUTE
  43 C  20   CN=AA
  44         CN=.5-.5*(AA*AA+SN*SN)
  45         SN=CN*SN+SN
  46 20      CN=CN*AA+AA
  47         RETURN
  48         END
  49 \f\1a