website/archive/binaries/mac/src/disembl/Tisean_3.0.1/source_f/slatec/radf5.f

   1 *DECK RADF5
   2       SUBROUTINE RADF5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
   3 C***BEGIN PROLOGUE  RADF5
   4 C***SUBSIDIARY
   5 C***PURPOSE  Calculate the fast Fourier transform of subvectors of
   6 C            length five.
   7 C***LIBRARY   SLATEC (FFTPACK)
   8 C***TYPE      SINGLE PRECISION (RADF5-S)
   9 C***AUTHOR  Swarztrauber, P. N., (NCAR)
  10 C***ROUTINES CALLED  (NONE)
  11 C***REVISION HISTORY  (YYMMDD)
  12 C   790601  DATE WRITTEN
  13 C   830401  Modified to use SLATEC library source file format.
  14 C   860115  Modified by Ron Boisvert to adhere to Fortran 77 by
  15 C           (a) changing dummy array size declarations (1) to (*),
  16 C           (b) changing definition of variables PI, TI11, TI12,
  17 C               TR11, TR12 by using FORTRAN intrinsic functions ATAN
  18 C               and SIN instead of DATA statements.
  19 C   881128  Modified by Dick Valent to meet prologue standards.
  20 C   890831  Modified array declarations.  (WRB)
  21 C   891214  Prologue converted to Version 4.0 format.  (BAB)
  22 C   900402  Added TYPE section.  (WRB)
  23 C***END PROLOGUE  RADF5
  24       DIMENSION CC(IDO,L1,5), CH(IDO,5,*), WA1(*), WA2(*), WA3(*),
  25      +          WA4(*)
  26 C***FIRST EXECUTABLE STATEMENT  RADF5
  27       PI = 4.*ATAN(1.)
  28       TR11 = SIN(.1*PI)
  29       TI11 = SIN(.4*PI)
  30       TR12 = -SIN(.3*PI)
  31       TI12 = SIN(.2*PI)
  32       DO 101 K=1,L1
  33          CR2 = CC(1,K,5)+CC(1,K,2)
  34          CI5 = CC(1,K,5)-CC(1,K,2)
  35          CR3 = CC(1,K,4)+CC(1,K,3)
  36          CI4 = CC(1,K,4)-CC(1,K,3)
  37          CH(1,1,K) = CC(1,K,1)+CR2+CR3
  38          CH(IDO,2,K) = CC(1,K,1)+TR11*CR2+TR12*CR3
  39          CH(1,3,K) = TI11*CI5+TI12*CI4
  40          CH(IDO,4,K) = CC(1,K,1)+TR12*CR2+TR11*CR3
  41          CH(1,5,K) = TI12*CI5-TI11*CI4
  42   101 CONTINUE
  43       IF (IDO .EQ. 1) RETURN
  44       IDP2 = IDO+2
  45       IF((IDO-1)/2.LT.L1) GO TO 104
  46       DO 103 K=1,L1
  47 CDIR$ IVDEP
  48          DO 102 I=3,IDO,2
  49             IC = IDP2-I
  50             DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
  51             DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
  52             DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
  53             DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
  54             DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
  55             DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
  56             DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
  57             DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
  58             CR2 = DR2+DR5
  59             CI5 = DR5-DR2
  60             CR5 = DI2-DI5
  61             CI2 = DI2+DI5
  62             CR3 = DR3+DR4
  63             CI4 = DR4-DR3
  64             CR4 = DI3-DI4
  65             CI3 = DI3+DI4
  66             CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
  67             CH(I,1,K) = CC(I,K,1)+CI2+CI3
  68             TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
  69             TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
  70             TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
  71             TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
  72             TR5 = TI11*CR5+TI12*CR4
  73             TI5 = TI11*CI5+TI12*CI4
  74             TR4 = TI12*CR5-TI11*CR4
  75             TI4 = TI12*CI5-TI11*CI4
  76             CH(I-1,3,K) = TR2+TR5
  77             CH(IC-1,2,K) = TR2-TR5
  78             CH(I,3,K) = TI2+TI5
  79             CH(IC,2,K) = TI5-TI2
  80             CH(I-1,5,K) = TR3+TR4
  81             CH(IC-1,4,K) = TR3-TR4
  82             CH(I,5,K) = TI3+TI4
  83             CH(IC,4,K) = TI4-TI3
  84   102    CONTINUE
  85   103 CONTINUE
  86       RETURN
  87   104 DO 106 I=3,IDO,2
  88          IC = IDP2-I
  89 CDIR$ IVDEP
  90          DO 105 K=1,L1
  91             DR2 = WA1(I-2)*CC(I-1,K,2)+WA1(I-1)*CC(I,K,2)
  92             DI2 = WA1(I-2)*CC(I,K,2)-WA1(I-1)*CC(I-1,K,2)
  93             DR3 = WA2(I-2)*CC(I-1,K,3)+WA2(I-1)*CC(I,K,3)
  94             DI3 = WA2(I-2)*CC(I,K,3)-WA2(I-1)*CC(I-1,K,3)
  95             DR4 = WA3(I-2)*CC(I-1,K,4)+WA3(I-1)*CC(I,K,4)
  96             DI4 = WA3(I-2)*CC(I,K,4)-WA3(I-1)*CC(I-1,K,4)
  97             DR5 = WA4(I-2)*CC(I-1,K,5)+WA4(I-1)*CC(I,K,5)
  98             DI5 = WA4(I-2)*CC(I,K,5)-WA4(I-1)*CC(I-1,K,5)
  99             CR2 = DR2+DR5
 100             CI5 = DR5-DR2
 101             CR5 = DI2-DI5
 102             CI2 = DI2+DI5
 103             CR3 = DR3+DR4
 104             CI4 = DR4-DR3
 105             CR4 = DI3-DI4
 106             CI3 = DI3+DI4
 107             CH(I-1,1,K) = CC(I-1,K,1)+CR2+CR3
 108             CH(I,1,K) = CC(I,K,1)+CI2+CI3
 109             TR2 = CC(I-1,K,1)+TR11*CR2+TR12*CR3
 110             TI2 = CC(I,K,1)+TR11*CI2+TR12*CI3
 111             TR3 = CC(I-1,K,1)+TR12*CR2+TR11*CR3
 112             TI3 = CC(I,K,1)+TR12*CI2+TR11*CI3
 113             TR5 = TI11*CR5+TI12*CR4
 114             TI5 = TI11*CI5+TI12*CI4
 115             TR4 = TI12*CR5-TI11*CR4
 116             TI4 = TI12*CI5-TI11*CI4
 117             CH(I-1,3,K) = TR2+TR5
 118             CH(IC-1,2,K) = TR2-TR5
 119             CH(I,3,K) = TI2+TI5
 120             CH(IC,2,K) = TI5-TI2
 121             CH(I-1,5,K) = TR3+TR4
 122             CH(IC-1,4,K) = TR3-TR4
 123             CH(I,5,K) = TI3+TI4
 124             CH(IC,4,K) = TI4-TI3
 125   105    CONTINUE
 126   106 CONTINUE
 127       RETURN
 128       END