share/fftpack5/fortran/mradb3.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 MRADB3 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2,WA1,WA2)
  12       REAL       CC(IN1,IDO,3,L1)    ,CH(IN2,IDO,L1,3),
  13      1           WA1(IDO)   ,WA2(IDO)
  14 C
  15       M1D = (M-1)*IM1+1
  16       M2S = 1-IM2
  17       ARG=2.*4.*ATAN(1.0)/3.
  18       TAUR=COS(ARG)
  19       TAUI=SIN(ARG)
  20       DO 101 K=1,L1
  21           M2 = M2S
  22           DO 1001 M1=1,M1D,IM1
  23           M2 = M2+IM2
  24          CH(M2,1,K,1) = CC(M1,1,1,K)+2.*CC(M1,IDO,2,K)
  25          CH(M2,1,K,2) = CC(M1,1,1,K)+(2.*TAUR)*CC(M1,IDO,2,K)
  26      1   -(2.*TAUI)*CC(M1,1,3,K)
  27          CH(M2,1,K,3) = CC(M1,1,1,K)+(2.*TAUR)*CC(M1,IDO,2,K)
  28      1   +2.*TAUI*CC(M1,1,3,K)
  29  1001     CONTINUE
  30   101 CONTINUE
  31       IF (IDO .EQ. 1) RETURN
  32       IDP2 = IDO+2
  33       DO 103 K=1,L1
  34          DO 102 I=3,IDO,2
  35             IC = IDP2-I
  36                M2 = M2S
  37                DO 1002 M1=1,M1D,IM1
  38                M2 = M2+IM2
  39         CH(M2,I-1,K,1) = CC(M1,I-1,1,K)+(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
  40         CH(M2,I,K,1) = CC(M1,I,1,K)+(CC(M1,I,3,K)-CC(M1,IC,2,K))
  41         CH(M2,I-1,K,2) = WA1(I-2)*
  42      1 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))-
  43      * (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
  44      2                   -WA1(I-1)*
  45      3 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))+
  46      * (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
  47             CH(M2,I,K,2) = WA1(I-2)*
  48      4 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))+
  49      8 (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
  50      5                  +WA1(I-1)*
  51      6 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))-
  52      8 (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
  53               CH(M2,I-1,K,3) = WA2(I-2)*
  54      7 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))+
  55      8 (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
  56      8   -WA2(I-1)*
  57      9 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))-
  58      8 (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
  59             CH(M2,I,K,3) = WA2(I-2)*
  60      1 ((CC(M1,I,1,K)+TAUR*(CC(M1,I,3,K)-CC(M1,IC,2,K)))-
  61      8 (TAUI*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))))
  62      2                 +WA2(I-1)*
  63      3 ((CC(M1,I-1,1,K)+TAUR*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K)))+
  64      8 (TAUI*(CC(M1,I,3,K)+CC(M1,IC,2,K))))
  65  1002          CONTINUE
  66   102    CONTINUE
  67   103 CONTINUE
  68       RETURN
  69       END