share/fftpack5/fortran/mradf3.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 MRADF3 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2,WA1,WA2)
  12       REAL       CH(IN2,IDO,3,L1)  ,CC(IN1,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,1,K) = CC(M1,1,K,1)+(CC(M1,1,K,2)+CC(M1,1,K,3))
  25          CH(M2,1,3,K) = TAUI*(CC(M1,1,K,3)-CC(M1,1,K,2))
  26          CH(M2,IDO,2,K) = CC(M1,1,K,1)+TAUR*
  27      1      (CC(M1,1,K,2)+CC(M1,1,K,3))
  28  1001    CONTINUE
  29   101 CONTINUE
  30       IF (IDO .EQ. 1) RETURN
  31       IDP2 = IDO+2
  32       DO 103 K=1,L1
  33          DO 102 I=3,IDO,2
  34             IC = IDP2-I
  35             M2 = M2S
  36             DO 1002 M1=1,M1D,IM1
  37             M2 = M2+IM2
  38             CH(M2,I-1,1,K) = CC(M1,I-1,K,1)+((WA1(I-2)*CC(M1,I-1,K,2)+
  39      1       WA1(I-1)*CC(M1,I,K,2))+(WA2(I-2)*CC(M1,I-1,K,3)+WA2(I-1)*
  40      1       CC(M1,I,K,3)))
  41             CH(M2,I,1,K) = CC(M1,I,K,1)+((WA1(I-2)*CC(M1,I,K,2)-
  42      1       WA1(I-1)*CC(M1,I-1,K,2))+(WA2(I-2)*CC(M1,I,K,3)-WA2(I-1)*
  43      1       CC(M1,I-1,K,3)))
  44             CH(M2,I-1,3,K) = (CC(M1,I-1,K,1)+TAUR*((WA1(I-2)*
  45      1       CC(M1,I-1,K,2)+WA1(I-1)*CC(M1,I,K,2))+(WA2(I-2)*
  46      1       CC(M1,I-1,K,3)+WA2(I-1)*CC(M1,I,K,3))))+(TAUI*((WA1(I-2)*
  47      1       CC(M1,I,K,2)-WA1(I-1)*CC(M1,I-1,K,2))-(WA2(I-2)*
  48      1       CC(M1,I,K,3)-WA2(I-1)*CC(M1,I-1,K,3))))
  49             CH(M2,IC-1,2,K) = (CC(M1,I-1,K,1)+TAUR*((WA1(I-2)*
  50      1       CC(M1,I-1,K,2)+WA1(I-1)*CC(M1,I,K,2))+(WA2(I-2)*
  51      1       CC(M1,I-1,K,3)+WA2(I-1)*CC(M1,I,K,3))))-(TAUI*((WA1(I-2)*
  52      1       CC(M1,I,K,2)-WA1(I-1)*CC(M1,I-1,K,2))-(WA2(I-2)*
  53      1       CC(M1,I,K,3)-WA2(I-1)*CC(M1,I-1,K,3))))
  54             CH(M2,I,3,K) = (CC(M1,I,K,1)+TAUR*((WA1(I-2)*CC(M1,I,K,2)-
  55      1       WA1(I-1)*CC(M1,I-1,K,2))+(WA2(I-2)*CC(M1,I,K,3)-WA2(I-1)*
  56      1       CC(M1,I-1,K,3))))+(TAUI*((WA2(I-2)*CC(M1,I-1,K,3)+WA2(I-1)*
  57      1       CC(M1,I,K,3))-(WA1(I-2)*CC(M1,I-1,K,2)+WA1(I-1)*
  58      1       CC(M1,I,K,2))))
  59             CH(M2,IC,2,K) = (TAUI*((WA2(I-2)*CC(M1,I-1,K,3)+WA2(I-1)*
  60      1       CC(M1,I,K,3))-(WA1(I-2)*CC(M1,I-1,K,2)+WA1(I-1)*
  61      1       CC(M1,I,K,2))))-(CC(M1,I,K,1)+TAUR*((WA1(I-2)*CC(M1,I,K,2)-
  62      1       WA1(I-1)*CC(M1,I-1,K,2))+(WA2(I-2)*CC(M1,I,K,3)-WA2(I-1)*
  63      1       CC(M1,I-1,K,3))))
  64  1002       CONTINUE
  65   102    CONTINUE
  66   103 CONTINUE
  67       RETURN
  68       END