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