share/fftpack5/fortran/r1f3kf.f

   1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 C
   3 C   FFTPACK 5.0
   4 C
   5 C   Authors:  Paul N. Swarztrauber and Richard A. Valent
   6 C
   7 C   $Id$
   8 C
   9 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10
  11       SUBROUTINE R1F3KF (IDO,L1,CC,IN1,CH,IN2,WA1,WA2)
  12       REAL       CH(IN2,IDO,3,L1)  ,CC(IN1,IDO,L1,3)     ,
  13      1                WA1(IDO)     ,WA2(IDO)
  14 C
  15       ARG=2.*4.*ATAN(1.0)/3.
  16       TAUR=COS(ARG)
  17       TAUI=SIN(ARG)
  18       DO 101 K=1,L1
  19          CH(1,1,1,K) = CC(1,1,K,1)+(CC(1,1,K,2)+CC(1,1,K,3))
  20          CH(1,1,3,K) = TAUI*(CC(1,1,K,3)-CC(1,1,K,2))
  21          CH(1,IDO,2,K) = CC(1,1,K,1)+TAUR*
  22      1      (CC(1,1,K,2)+CC(1,1,K,3))
  23   101 CONTINUE
  24       IF (IDO .EQ. 1) RETURN
  25       IDP2 = IDO+2
  26       DO 103 K=1,L1
  27          DO 102 I=3,IDO,2
  28             IC = IDP2-I
  29             CH(1,I-1,1,K) = CC(1,I-1,K,1)+((WA1(I-2)*CC(1,I-1,K,2)+
  30      1       WA1(I-1)*CC(1,I,K,2))+(WA2(I-2)*CC(1,I-1,K,3)+WA2(I-1)*
  31      1       CC(1,I,K,3)))
  32             CH(1,I,1,K) = CC(1,I,K,1)+((WA1(I-2)*CC(1,I,K,2)-
  33      1       WA1(I-1)*CC(1,I-1,K,2))+(WA2(I-2)*CC(1,I,K,3)-WA2(I-1)*
  34      1       CC(1,I-1,K,3)))
  35             CH(1,I-1,3,K) = (CC(1,I-1,K,1)+TAUR*((WA1(I-2)*
  36      1       CC(1,I-1,K,2)+WA1(I-1)*CC(1,I,K,2))+(WA2(I-2)*
  37      1       CC(1,I-1,K,3)+WA2(I-1)*CC(1,I,K,3))))+(TAUI*((WA1(I-2)*
  38      1       CC(1,I,K,2)-WA1(I-1)*CC(1,I-1,K,2))-(WA2(I-2)*
  39      1       CC(1,I,K,3)-WA2(I-1)*CC(1,I-1,K,3))))
  40             CH(1,IC-1,2,K) = (CC(1,I-1,K,1)+TAUR*((WA1(I-2)*
  41      1       CC(1,I-1,K,2)+WA1(I-1)*CC(1,I,K,2))+(WA2(I-2)*
  42      1       CC(1,I-1,K,3)+WA2(I-1)*CC(1,I,K,3))))-(TAUI*((WA1(I-2)*
  43      1       CC(1,I,K,2)-WA1(I-1)*CC(1,I-1,K,2))-(WA2(I-2)*
  44      1       CC(1,I,K,3)-WA2(I-1)*CC(1,I-1,K,3))))
  45             CH(1,I,3,K) = (CC(1,I,K,1)+TAUR*((WA1(I-2)*CC(1,I,K,2)-
  46      1       WA1(I-1)*CC(1,I-1,K,2))+(WA2(I-2)*CC(1,I,K,3)-WA2(I-1)*
  47      1       CC(1,I-1,K,3))))+(TAUI*((WA2(I-2)*CC(1,I-1,K,3)+WA2(I-1)*
  48      1       CC(1,I,K,3))-(WA1(I-2)*CC(1,I-1,K,2)+WA1(I-1)*
  49      1       CC(1,I,K,2))))
  50             CH(1,IC,2,K) = (TAUI*((WA2(I-2)*CC(1,I-1,K,3)+WA2(I-1)*
  51      1       CC(1,I,K,3))-(WA1(I-2)*CC(1,I-1,K,2)+WA1(I-1)*
  52      1       CC(1,I,K,2))))-(CC(1,I,K,1)+TAUR*((WA1(I-2)*CC(1,I,K,2)-
  53      1       WA1(I-1)*CC(1,I-1,K,2))+(WA2(I-2)*CC(1,I,K,3)-WA2(I-1)*
  54      1       CC(1,I-1,K,3))))
  55   102    CONTINUE
  56   103 CONTINUE
  57       RETURN
  58       END