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