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

   1 *DECK RADB5
   2       SUBROUTINE RADB5 (IDO, L1, CC, CH, WA1, WA2, WA3, WA4)
   3 C***BEGIN PROLOGUE  RADB5
   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 (RADB5-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  RADB5
  24       DIMENSION CC(IDO,5,*), CH(IDO,L1,5), WA1(*), WA2(*), WA3(*),
  25      +          WA4(*)
  26 C***FIRST EXECUTABLE STATEMENT  RADB5
  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          TI5 = CC(1,3,K)+CC(1,3,K)
  34          TI4 = CC(1,5,K)+CC(1,5,K)
  35          TR2 = CC(IDO,2,K)+CC(IDO,2,K)
  36          TR3 = CC(IDO,4,K)+CC(IDO,4,K)
  37          CH(1,K,1) = CC(1,1,K)+TR2+TR3
  38          CR2 = CC(1,1,K)+TR11*TR2+TR12*TR3
  39          CR3 = CC(1,1,K)+TR12*TR2+TR11*TR3
  40          CI5 = TI11*TI5+TI12*TI4
  41          CI4 = TI12*TI5-TI11*TI4
  42          CH(1,K,2) = CR2-CI5
  43          CH(1,K,3) = CR3-CI4
  44          CH(1,K,4) = CR3+CI4
  45          CH(1,K,5) = CR2+CI5
  46   101 CONTINUE
  47       IF (IDO .EQ. 1) RETURN
  48       IDP2 = IDO+2
  49       IF((IDO-1)/2.LT.L1) GO TO 104
  50       DO 103 K=1,L1
  51 CDIR$ IVDEP
  52          DO 102 I=3,IDO,2
  53             IC = IDP2-I
  54             TI5 = CC(I,3,K)+CC(IC,2,K)
  55             TI2 = CC(I,3,K)-CC(IC,2,K)
  56             TI4 = CC(I,5,K)+CC(IC,4,K)
  57             TI3 = CC(I,5,K)-CC(IC,4,K)
  58             TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
  59             TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
  60             TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
  61             TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
  62             CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
  63             CH(I,K,1) = CC(I,1,K)+TI2+TI3
  64             CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
  65             CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
  66             CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
  67             CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
  68             CR5 = TI11*TR5+TI12*TR4
  69             CI5 = TI11*TI5+TI12*TI4
  70             CR4 = TI12*TR5-TI11*TR4
  71             CI4 = TI12*TI5-TI11*TI4
  72             DR3 = CR3-CI4
  73             DR4 = CR3+CI4
  74             DI3 = CI3+CR4
  75             DI4 = CI3-CR4
  76             DR5 = CR2+CI5
  77             DR2 = CR2-CI5
  78             DI5 = CI2-CR5
  79             DI2 = CI2+CR5
  80             CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
  81             CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
  82             CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
  83             CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
  84             CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
  85             CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
  86             CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
  87             CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
  88   102    CONTINUE
  89   103 CONTINUE
  90       RETURN
  91   104 DO 106 I=3,IDO,2
  92          IC = IDP2-I
  93 CDIR$ IVDEP
  94          DO 105 K=1,L1
  95             TI5 = CC(I,3,K)+CC(IC,2,K)
  96             TI2 = CC(I,3,K)-CC(IC,2,K)
  97             TI4 = CC(I,5,K)+CC(IC,4,K)
  98             TI3 = CC(I,5,K)-CC(IC,4,K)
  99             TR5 = CC(I-1,3,K)-CC(IC-1,2,K)
 100             TR2 = CC(I-1,3,K)+CC(IC-1,2,K)
 101             TR4 = CC(I-1,5,K)-CC(IC-1,4,K)
 102             TR3 = CC(I-1,5,K)+CC(IC-1,4,K)
 103             CH(I-1,K,1) = CC(I-1,1,K)+TR2+TR3
 104             CH(I,K,1) = CC(I,1,K)+TI2+TI3
 105             CR2 = CC(I-1,1,K)+TR11*TR2+TR12*TR3
 106             CI2 = CC(I,1,K)+TR11*TI2+TR12*TI3
 107             CR3 = CC(I-1,1,K)+TR12*TR2+TR11*TR3
 108             CI3 = CC(I,1,K)+TR12*TI2+TR11*TI3
 109             CR5 = TI11*TR5+TI12*TR4
 110             CI5 = TI11*TI5+TI12*TI4
 111             CR4 = TI12*TR5-TI11*TR4
 112             CI4 = TI12*TI5-TI11*TI4
 113             DR3 = CR3-CI4
 114             DR4 = CR3+CI4
 115             DI3 = CI3+CR4
 116             DI4 = CI3-CR4
 117             DR5 = CR2+CI5
 118             DR2 = CR2-CI5
 119             DI5 = CI2-CR5
 120             DI2 = CI2+CR5
 121             CH(I-1,K,2) = WA1(I-2)*DR2-WA1(I-1)*DI2
 122             CH(I,K,2) = WA1(I-2)*DI2+WA1(I-1)*DR2
 123             CH(I-1,K,3) = WA2(I-2)*DR3-WA2(I-1)*DI3
 124             CH(I,K,3) = WA2(I-2)*DI3+WA2(I-1)*DR3
 125             CH(I-1,K,4) = WA3(I-2)*DR4-WA3(I-1)*DI4
 126             CH(I,K,4) = WA3(I-2)*DI4+WA3(I-1)*DR4
 127             CH(I-1,K,5) = WA4(I-2)*DR5-WA4(I-1)*DI5
 128             CH(I,K,5) = WA4(I-2)*DI5+WA4(I-1)*DR5
 129   105    CONTINUE
 130   106 CONTINUE
 131       RETURN
 132       END