share/fftpack5/fortran/mradb5.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 MRADB5 (M,IDO,L1,CC,IM1,IN1,CH,IM2,IN2,
  12      1       WA1,WA2,WA3,WA4)
  13       REAL   CC(IN1,IDO,5,L1)    ,CH(IN2,IDO,L1,5),
  14      1       WA1(IDO)     ,WA2(IDO)     ,WA3(IDO)     ,WA4(IDO)
  15 C
  16       M1D = (M-1)*IM1+1
  17       M2S = 1-IM2
  18       ARG=2.*4.*ATAN(1.0)/5.
  19       TR11=COS(ARG)
  20       TI11=SIN(ARG)
  21       TR12=COS(2.*ARG)
  22       TI12=SIN(2.*ARG)
  23       DO 101 K=1,L1
  24       M2 = M2S
  25       DO 1001 M1=1,M1D,IM1
  26          M2 = M2+IM2
  27          CH(M2,1,K,1) = CC(M1,1,1,K)+2.*CC(M1,IDO,2,K)+2.*CC(M1,IDO,4,K)
  28          CH(M2,1,K,2) = (CC(M1,1,1,K)+TR11*2.*CC(M1,IDO,2,K)
  29      1   +TR12*2.*CC(M1,IDO,4,K))-(TI11*2.*CC(M1,1,3,K)
  30      1   +TI12*2.*CC(M1,1,5,K))
  31          CH(M2,1,K,3) = (CC(M1,1,1,K)+TR12*2.*CC(M1,IDO,2,K)
  32      1   +TR11*2.*CC(M1,IDO,4,K))-(TI12*2.*CC(M1,1,3,K)
  33      1   -TI11*2.*CC(M1,1,5,K))
  34          CH(M2,1,K,4) = (CC(M1,1,1,K)+TR12*2.*CC(M1,IDO,2,K)
  35      1   +TR11*2.*CC(M1,IDO,4,K))+(TI12*2.*CC(M1,1,3,K)
  36      1   -TI11*2.*CC(M1,1,5,K))
  37          CH(M2,1,K,5) = (CC(M1,1,1,K)+TR11*2.*CC(M1,IDO,2,K)
  38      1   +TR12*2.*CC(M1,IDO,4,K))+(TI11*2.*CC(M1,1,3,K)
  39      1   +TI12*2.*CC(M1,1,5,K))
  40  1001          CONTINUE
  41   101 CONTINUE
  42       IF (IDO .EQ. 1) RETURN
  43       IDP2 = IDO+2
  44       DO 103 K=1,L1
  45          DO 102 I=3,IDO,2
  46             IC = IDP2-I
  47             M2 = M2S
  48       DO 1002 M1=1,M1D,IM1
  49         M2 = M2+IM2
  50         CH(M2,I-1,K,1) = CC(M1,I-1,1,K)+(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
  51      1  +(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K))
  52         CH(M2,I,K,1) = CC(M1,I,1,K)+(CC(M1,I,3,K)-CC(M1,IC,2,K))
  53      1  +(CC(M1,I,5,K)-CC(M1,IC,4,K))
  54         CH(M2,I-1,K,2) = WA1(I-2)*((CC(M1,I-1,1,K)+TR11*
  55      1  (CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))+TR12
  56      1  *(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))-(TI11*(CC(M1,I,3,K)
  57      1  +CC(M1,IC,2,K))+TI12*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
  58      1  -WA1(I-1)*((CC(M1,I,1,K)+TR11*(CC(M1,I,3,K)-CC(M1,IC,2,K))
  59      1  +TR12*(CC(M1,I,5,K)-CC(M1,IC,4,K)))+(TI11*(CC(M1,I-1,3,K)
  60      1  -CC(M1,IC-1,2,K))+TI12*(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
  61         CH(M2,I,K,2) = WA1(I-2)*((CC(M1,I,1,K)+TR11*(CC(M1,I,3,K)
  62      1  -CC(M1,IC,2,K))+TR12*(CC(M1,I,5,K)-CC(M1,IC,4,K)))
  63      1  +(TI11*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))+TI12
  64      1  *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))+WA1(I-1)
  65      1  *((CC(M1,I-1,1,K)+TR11*(CC(M1,I-1,3,K)
  66      1  +CC(M1,IC-1,2,K))+TR12*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))
  67      1  -(TI11*(CC(M1,I,3,K)+CC(M1,IC,2,K))+TI12
  68      1  *(CC(M1,I,5,K)+CC(M1,IC,4,K))))
  69         CH(M2,I-1,K,3) = WA2(I-2)
  70      1  *((CC(M1,I-1,1,K)+TR12*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
  71      1  +TR11*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))-(TI12*(CC(M1,I,3,K)
  72      1  +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
  73      1 -WA2(I-1)
  74      1 *((CC(M1,I,1,K)+TR12*(CC(M1,I,3,K)-
  75      1  CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K)))
  76      1  +(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11
  77      1  *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
  78         CH(M2,I,K,3) = WA2(I-2)
  79      1 *((CC(M1,I,1,K)+TR12*(CC(M1,I,3,K)-
  80      1  CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K)))
  81      1  +(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11
  82      1  *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
  83      1  +WA2(I-1)
  84      1  *((CC(M1,I-1,1,K)+TR12*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
  85      1  +TR11*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))-(TI12*(CC(M1,I,3,K)
  86      1  +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
  87         CH(M2,I-1,K,4) = WA3(I-2)
  88      1  *((CC(M1,I-1,1,K)+TR12*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
  89      1  +TR11*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI12*(CC(M1,I,3,K)
  90      1  +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
  91      1  -WA3(I-1)
  92      1 *((CC(M1,I,1,K)+TR12*(CC(M1,I,3,K)-
  93      1  CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K)))
  94      1  -(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11
  95      1  *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
  96         CH(M2,I,K,4) = WA3(I-2)
  97      1 *((CC(M1,I,1,K)+TR12*(CC(M1,I,3,K)-
  98      1  CC(M1,IC,2,K))+TR11*(CC(M1,I,5,K)-CC(M1,IC,4,K)))
  99      1  -(TI12*(CC(M1,I-1,3,K)-CC(M1,IC-1,2,K))-TI11
 100      1  *(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
 101      1  +WA3(I-1)
 102      1  *((CC(M1,I-1,1,K)+TR12*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
 103      1  +TR11*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI12*(CC(M1,I,3,K)
 104      1  +CC(M1,IC,2,K))-TI11*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
 105         CH(M2,I-1,K,5) = WA4(I-2)
 106      1  *((CC(M1,I-1,1,K)+TR11*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
 107      1  +TR12*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI11*(CC(M1,I,3,K)
 108      1  +CC(M1,IC,2,K))+TI12*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
 109      1  -WA4(I-1)
 110      1  *((CC(M1,I,1,K)+TR11*(CC(M1,I,3,K)-CC(M1,IC,2,K))
 111      1  +TR12*(CC(M1,I,5,K)-CC(M1,IC,4,K)))-(TI11*(CC(M1,I-1,3,K)
 112      1  -CC(M1,IC-1,2,K))+TI12*(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
 113         CH(M2,I,K,5) = WA4(I-2)
 114      1  *((CC(M1,I,1,K)+TR11*(CC(M1,I,3,K)-CC(M1,IC,2,K))
 115      1  +TR12*(CC(M1,I,5,K)-CC(M1,IC,4,K)))-(TI11*(CC(M1,I-1,3,K)
 116      1  -CC(M1,IC-1,2,K))+TI12*(CC(M1,I-1,5,K)-CC(M1,IC-1,4,K))))
 117      1  +WA4(I-1)
 118      1  *((CC(M1,I-1,1,K)+TR11*(CC(M1,I-1,3,K)+CC(M1,IC-1,2,K))
 119      1  +TR12*(CC(M1,I-1,5,K)+CC(M1,IC-1,4,K)))+(TI11*(CC(M1,I,3,K)
 120      1  +CC(M1,IC,2,K))+TI12*(CC(M1,I,5,K)+CC(M1,IC,4,K))))
 121  1002      CONTINUE
 122   102    CONTINUE
 123   103 CONTINUE
 124       RETURN
 125       END