share/fftpack5/fortran/mradf4.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 MRADF4 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2,WA1,WA2,WA3)
  12       REAL       CC(IN1,IDO,L1,4)   ,CH(IN2,IDO,4,L1)     ,
  13      1           WA1(IDO)           ,WA2(IDO)     ,WA3(IDO)
  14 C
  15       HSQT2=SQRT(2.)/2.
  16       M1D = (M-1)*IM1+1
  17       M2S = 1-IM2
  18       DO 101 K=1,L1
  19          M2 = M2S
  20          DO 1001 M1=1,M1D,IM1
  21          M2 = M2+IM2
  22          CH(M2,1,1,K) = (CC(M1,1,K,2)+CC(M1,1,K,4))
  23      1      +(CC(M1,1,K,1)+CC(M1,1,K,3))
  24          CH(M2,IDO,4,K) = (CC(M1,1,K,1)+CC(M1,1,K,3))
  25      1      -(CC(M1,1,K,2)+CC(M1,1,K,4))
  26          CH(M2,IDO,2,K) = CC(M1,1,K,1)-CC(M1,1,K,3)
  27          CH(M2,1,3,K) = CC(M1,1,K,4)-CC(M1,1,K,2)
  28  1001    CONTINUE
  29   101 CONTINUE
  30       IF (IDO-2) 107,105,102
  31   102 IDP2 = IDO+2
  32       DO 104 K=1,L1
  33          DO 103 I=3,IDO,2
  34             IC = IDP2-I
  35             M2 = M2S
  36             DO 1003 M1=1,M1D,IM1
  37             M2 = M2+IM2
  38             CH(M2,I-1,1,K) = ((WA1(I-2)*CC(M1,I-1,K,2)+WA1(I-1)*
  39      1       CC(M1,I,K,2))+(WA3(I-2)*CC(M1,I-1,K,4)+WA3(I-1)*
  40      1       CC(M1,I,K,4)))+(CC(M1,I-1,K,1)+(WA2(I-2)*CC(M1,I-1,K,3)+
  41      1       WA2(I-1)*CC(M1,I,K,3)))
  42             CH(M2,IC-1,4,K) = (CC(M1,I-1,K,1)+(WA2(I-2)*CC(M1,I-1,K,3)+
  43      1       WA2(I-1)*CC(M1,I,K,3)))-((WA1(I-2)*CC(M1,I-1,K,2)+
  44      1       WA1(I-1)*CC(M1,I,K,2))+(WA3(I-2)*CC(M1,I-1,K,4)+
  45      1       WA3(I-1)*CC(M1,I,K,4)))
  46             CH(M2,I,1,K) = ((WA1(I-2)*CC(M1,I,K,2)-WA1(I-1)*
  47      1       CC(M1,I-1,K,2))+(WA3(I-2)*CC(M1,I,K,4)-WA3(I-1)*
  48      1       CC(M1,I-1,K,4)))+(CC(M1,I,K,1)+(WA2(I-2)*CC(M1,I,K,3)-
  49      1       WA2(I-1)*CC(M1,I-1,K,3)))
  50             CH(M2,IC,4,K) = ((WA1(I-2)*CC(M1,I,K,2)-WA1(I-1)*
  51      1       CC(M1,I-1,K,2))+(WA3(I-2)*CC(M1,I,K,4)-WA3(I-1)*
  52      1       CC(M1,I-1,K,4)))-(CC(M1,I,K,1)+(WA2(I-2)*CC(M1,I,K,3)-
  53      1       WA2(I-1)*CC(M1,I-1,K,3)))
  54             CH(M2,I-1,3,K) = ((WA1(I-2)*CC(M1,I,K,2)-WA1(I-1)*
  55      1       CC(M1,I-1,K,2))-(WA3(I-2)*CC(M1,I,K,4)-WA3(I-1)*
  56      1       CC(M1,I-1,K,4)))+(CC(M1,I-1,K,1)-(WA2(I-2)*CC(M1,I-1,K,3)+
  57      1       WA2(I-1)*CC(M1,I,K,3)))
  58             CH(M2,IC-1,2,K) = (CC(M1,I-1,K,1)-(WA2(I-2)*CC(M1,I-1,K,3)+
  59      1       WA2(I-1)*CC(M1,I,K,3)))-((WA1(I-2)*CC(M1,I,K,2)-WA1(I-1)*
  60      1       CC(M1,I-1,K,2))-(WA3(I-2)*CC(M1,I,K,4)-WA3(I-1)*
  61      1       CC(M1,I-1,K,4)))
  62             CH(M2,I,3,K) = ((WA3(I-2)*CC(M1,I-1,K,4)+WA3(I-1)*
  63      1       CC(M1,I,K,4))-(WA1(I-2)*CC(M1,I-1,K,2)+WA1(I-1)*
  64      1       CC(M1,I,K,2)))+(CC(M1,I,K,1)-(WA2(I-2)*CC(M1,I,K,3)-
  65      1       WA2(I-1)*CC(M1,I-1,K,3)))
  66             CH(M2,IC,2,K) = ((WA3(I-2)*CC(M1,I-1,K,4)+WA3(I-1)*
  67      1       CC(M1,I,K,4))-(WA1(I-2)*CC(M1,I-1,K,2)+WA1(I-1)*
  68      1       CC(M1,I,K,2)))-(CC(M1,I,K,1)-(WA2(I-2)*CC(M1,I,K,3)-
  69      1       WA2(I-1)*CC(M1,I-1,K,3)))
  70  1003       CONTINUE
  71   103    CONTINUE
  72   104 CONTINUE
  73       IF (MOD(IDO,2) .EQ. 1) RETURN
  74   105 CONTINUE
  75       DO 106 K=1,L1
  76          M2 = M2S
  77          DO 1006 M1=1,M1D,IM1
  78             M2 = M2+IM2
  79             CH(M2,IDO,1,K) = (HSQT2*(CC(M1,IDO,K,2)-CC(M1,IDO,K,4)))+
  80      1       CC(M1,IDO,K,1)
  81             CH(M2,IDO,3,K) = CC(M1,IDO,K,1)-(HSQT2*(CC(M1,IDO,K,2)-
  82      1       CC(M1,IDO,K,4)))
  83             CH(M2,1,2,K) = (-HSQT2*(CC(M1,IDO,K,2)+CC(M1,IDO,K,4)))-
  84      1       CC(M1,IDO,K,3)
  85             CH(M2,1,4,K) = (-HSQT2*(CC(M1,IDO,K,2)+CC(M1,IDO,K,4)))+
  86      1       CC(M1,IDO,K,3)
  87  1006    CONTINUE
  88   106 CONTINUE
  89   107 RETURN
  90       END