MINICERN/mathlib/gen/d/fftrc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/04/01 15:02:23  mclareni
   6 * Mathlib gen
   7 *
   8 *
   9 #include "gen/pilot.h"
  10       SUBROUTINE FFTRC(C,D,IX,F,G,IZ)
  11 C
  12 C         D701  FFTRC  FAST FOURIER TRANSFORM, REAL OR COMPLEX
  13 C         B. FORNBERG  NOVEMBER 1973
  14 C
  15       COMPLEX A(16),T
  16       DIMENSION E(32),C(1),D(1),F(1),G(1),S(2),NC(7)
  17       COMMON /TAB/U(126),V(127)
  18       EQUIVALENCE (A(1),E(1)),(S(1),T),(S(1),S1),(S(2),S2),(U(31),C3),(U
  19      *(63),C7),(U(32),C9)
  20       DATA NC/17,9,25,5,21,13,29/
  21 C
  22 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  23       ENTRY I16
  24 #endif
  25 #if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
  26       ENTRY I16(C,D,IX,F,G,IZ)
  27 #endif
  28       IS = IX
  29       I = 1
  30       GOTO 40
  31 C
  32 #if (defined(CERNLIB_CDC))&&(defined(CERNLIB_F4))
  33       ENTRY D16
  34 #endif
  35 #if !defined(CERNLIB_CDC)||!defined(CERNLIB_F4)
  36       ENTRY D16(C,D,IX,F,G,IZ)
  37 #endif
  38       IS = -IX
  39       I = 1+16*IX
  40    40 J = 1+8*IX
  41       CALL D701BD
  42       E(3) = C(1)-C(J)
  43       E(1) = C(1)+C(J)
  44       E(4) = D(1)-D(J)
  45       E(2) = D(1)+D(J)
  46       DO 10 L=1,7
  47       I = I+IS
  48       J = J+IS
  49       N = NC(L)
  50       E(N+2) = C(I)-C(J)
  51       E(N) = C(I)+C(J)
  52       E(N+3) = D(I)-D(J)
  53    10 E(N+1) = D(I)+D(J)
  54       DO 20 L=1,13,4
  55       T = A(L+2)
  56       A(L+2) = A(L)-T
  57    20 A(L) = A(L)+T
  58       DO 30 L=2,14,4
  59       S1 = E(2*L+4)
  60       S2 = -E(2*L+3)
  61       A(L+2) = A(L)-T
  62    30 A(L) = A(L)+T
  63       T = A(5)
  64       A(5) = A(1)-T
  65       A(1) = A(1)+T
  66       T = A(13)
  67       A(13) = A(9)-T
  68       A(9) = A(9)+T
  69       S2 = -C7*(E(11)-E(12))
  70       S1 = C7*(E(11)+E(12))
  71       A(6) = A(2)-T
  72       A(2) = A(2)+T
  73       S2 = -C7*(E(27)-E(28))
  74       S1 = C7*(E(27)+E(28))
  75       A(14) = A(10)-T
  76       A(10) = A(10)+T
  77       S1 = E(14)
  78       S2 = -E(13)
  79       A(7) = A(3)-T
  80       A(3) = A(3)+T
  81       S1 = E(30)
  82       S2 = -E(29)
  83       A(15) = A(11)-T
  84       A(11) = A(11)+T
  85       S2 = -C7*(E(15)+E(16))
  86       S1 = -C7*(E(15)-E(16))
  87       A(8) = A(4)-T
  88       A(4) = A(4)+T
  89       S1 = -C7*(E(31)-E(32))
  90       S2 = -C7*(E(31)+E(32))
  91       A(16) = A(12)-T
  92       A(12) = A(12)+T
  93       I = 1
  94       J = 1+8*IZ
  95       F(J) = E(1)-E(17)
  96       G(J) = E(2)-E(18)
  97       F(I) = E(1)+E(17)
  98       G(I) = E(2)+E(18)
  99       I = I+IZ
 100       J = J+IZ
 101       S1 = C9*E(19)+C3*E(20)
 102       S2 = C9*E(20)-C3*E(19)
 103       F(J) = E( 3)-S1
 104       G(J) = E( 4)-S2
 105       F(I) = E( 3)+S1
 106       G(I) = E( 4)+S2
 107       I = I+IZ
 108       J = J+IZ
 109       S1 = C7*(E(21)+E(22))
 110       S2 = -C7*(E(21)-E(22))
 111       F(J) = E( 5)-S1
 112       G(J) = E( 6)-S2
 113       F(I) = E( 5)+S1
 114       G(I) = E( 6)+S2
 115       I = I+IZ
 116       J = J+IZ
 117       S1 = C3*E(23)+C9*E(24)
 118       S2 = C3*E(24)-C9*E(23)
 119       F(J) = E( 7)-S1
 120       G(J) = E( 8)-S2
 121       F(I) = E( 7)+S1
 122       G(I) = E( 8)+S2
 123       I = I+IZ
 124       J = J+IZ
 125       F(J) = E(9)-E(26)
 126       G(J) = E(10)+E(25)
 127       F(I) = E(9)+E(26)
 128       G(I) = E(10)-E(25)
 129       I = I+IZ
 130       J = J+IZ
 131       S1 = -C3*E(27)+C9*E(28)
 132       S2 = -C3*E(28)-C9*E(27)
 133       F(J) = E(11)-S1
 134       G(J) = E(12)-S2
 135       F(I) = E(11)+S1
 136       G(I) = E(12)+S2
 137       I = I+IZ
 138       J = J+IZ
 139       S1 = -C7*(E(29)-E(30))
 140       S2 = -C7*(E(29)+E(30))
 141       F(J) = E(13)-S1
 142       G(J) = E(14)-S2
 143       F(I) = E(13)+S1
 144       G(I) = E(14)+S2
 145       I = I+IZ
 146       J = J+IZ
 147       S1 = -C9*E(31)+C3*E(32)
 148       S2 = -C9*E(32)-C3*E(31)
 149       F(J) = E(15)-S1
 150       G(J) = E(16)-S2
 151       F(I) = E(15)+S1
 152       G(I) = E(16)+S2
 153       RETURN
 154       END