share/fftpack5/fortran/r1f3kb.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 R1F3KB (IDO,L1,CC,IN1,CH,IN2,WA1,WA2)
  12       REAL       CC(IN1,IDO,3,L1)    ,CH(IN2,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,K,1) = CC(1,1,1,K)+2.*CC(1,IDO,2,K)
  20          CH(1,1,K,2) = CC(1,1,1,K)+(2.*TAUR)*CC(1,IDO,2,K)
  21      1   -(2.*TAUI)*CC(1,1,3,K)
  22          CH(1,1,K,3) = CC(1,1,1,K)+(2.*TAUR)*CC(1,IDO,2,K)
  23      1   +2.*TAUI*CC(1,1,3,K)
  24   101 CONTINUE
  25       IF (IDO .EQ. 1) RETURN
  26       IDP2 = IDO+2
  27       DO 103 K=1,L1
  28          DO 102 I=3,IDO,2
  29             IC = IDP2-I
  30         CH(1,I-1,K,1) = CC(1,I-1,1,K)+(CC(1,I-1,3,K)+CC(1,IC-1,2,K))
  31         CH(1,I,K,1) = CC(1,I,1,K)+(CC(1,I,3,K)-CC(1,IC,2,K))
  32         CH(1,I-1,K,2) = WA1(I-2)*
  33      1 ((CC(1,I-1,1,K)+TAUR*(CC(1,I-1,3,K)+CC(1,IC-1,2,K)))-
  34      * (TAUI*(CC(1,I,3,K)+CC(1,IC,2,K))))
  35      2                   -WA1(I-1)*
  36      3 ((CC(1,I,1,K)+TAUR*(CC(1,I,3,K)-CC(1,IC,2,K)))+
  37      * (TAUI*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))))
  38             CH(1,I,K,2) = WA1(I-2)*
  39      4 ((CC(1,I,1,K)+TAUR*(CC(1,I,3,K)-CC(1,IC,2,K)))+
  40      8 (TAUI*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))))
  41      5                  +WA1(I-1)*
  42      6 ((CC(1,I-1,1,K)+TAUR*(CC(1,I-1,3,K)+CC(1,IC-1,2,K)))-
  43      8 (TAUI*(CC(1,I,3,K)+CC(1,IC,2,K))))
  44               CH(1,I-1,K,3) = WA2(I-2)*
  45      7 ((CC(1,I-1,1,K)+TAUR*(CC(1,I-1,3,K)+CC(1,IC-1,2,K)))+
  46      8 (TAUI*(CC(1,I,3,K)+CC(1,IC,2,K))))
  47      8   -WA2(I-1)*
  48      9 ((CC(1,I,1,K)+TAUR*(CC(1,I,3,K)-CC(1,IC,2,K)))-
  49      8 (TAUI*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))))
  50             CH(1,I,K,3) = WA2(I-2)*
  51      1 ((CC(1,I,1,K)+TAUR*(CC(1,I,3,K)-CC(1,IC,2,K)))-
  52      8 (TAUI*(CC(1,I-1,3,K)-CC(1,IC-1,2,K))))
  53      2                 +WA2(I-1)*
  54      3 ((CC(1,I-1,1,K)+TAUR*(CC(1,I-1,3,K)+CC(1,IC-1,2,K)))+
  55      8 (TAUI*(CC(1,I,3,K)+CC(1,IC,2,K))))
  56   102    CONTINUE
  57   103 CONTINUE
  58       RETURN
  59       END