share/fftpack5/fortran/mradfg.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 MRADFG (M,IDO,IP,L1,IDL1,CC,C1,C2,IM1,IN1,
  12      1              CH,CH2,IM2,IN2,WA)
  13       REAL          CH(IN2,IDO,L1,IP)   ,CC(IN1,IDO,IP,L1),
  14      1              C1(IN1,IDO,L1,IP)   ,C2(IN1,IDL1,IP),
  15      2              CH2(IN2,IDL1,IP)    ,WA(IDO)
  16 C
  17       M1D = (M-1)*IM1+1
  18       M2S = 1-IM2
  19       TPI=2.*4.*ATAN(1.0)
  20       ARG = TPI/FLOAT(IP)
  21       DCP = COS(ARG)
  22       DSP = SIN(ARG)
  23       IPPH = (IP+1)/2
  24       IPP2 = IP+2
  25       IDP2 = IDO+2
  26       NBD = (IDO-1)/2
  27       IF (IDO .EQ. 1) GO TO 119
  28       DO 101 IK=1,IDL1
  29          M2 = M2S
  30          DO 1001 M1=1,M1D,IM1
  31          M2 = M2+IM2
  32          CH2(M2,IK,1) = C2(M1,IK,1)
  33  1001    CONTINUE
  34   101 CONTINUE
  35       DO 103 J=2,IP
  36          DO 102 K=1,L1
  37             M2 = M2S
  38             DO 1002 M1=1,M1D,IM1
  39             M2 = M2+IM2
  40             CH(M2,1,K,J) = C1(M1,1,K,J)
  41  1002       CONTINUE
  42   102    CONTINUE
  43   103 CONTINUE
  44       IF (NBD .GT. L1) GO TO 107
  45       IS = -IDO
  46       DO 106 J=2,IP
  47          IS = IS+IDO
  48          IDIJ = IS
  49          DO 105 I=3,IDO,2
  50             IDIJ = IDIJ+2
  51             DO 104 K=1,L1
  52                M2 = M2S
  53                DO 1004 M1=1,M1D,IM1
  54                M2 = M2+IM2
  55                CH(M2,I-1,K,J) = WA(IDIJ-1)*C1(M1,I-1,K,J)+WA(IDIJ)
  56      1           *C1(M1,I,K,J)
  57                CH(M2,I,K,J) = WA(IDIJ-1)*C1(M1,I,K,J)-WA(IDIJ)
  58      1           *C1(M1,I-1,K,J)
  59  1004          CONTINUE
  60   104       CONTINUE
  61   105    CONTINUE
  62   106 CONTINUE
  63       GO TO 111
  64   107 IS = -IDO
  65       DO 110 J=2,IP
  66          IS = IS+IDO
  67          DO 109 K=1,L1
  68             IDIJ = IS
  69             DO 108 I=3,IDO,2
  70                IDIJ = IDIJ+2
  71                M2 = M2S
  72                DO 1008 M1=1,M1D,IM1
  73                M2 = M2+IM2
  74                CH(M2,I-1,K,J) = WA(IDIJ-1)*C1(M1,I-1,K,J)+WA(IDIJ)
  75      1           *C1(M1,I,K,J)
  76                CH(M2,I,K,J) = WA(IDIJ-1)*C1(M1,I,K,J)-WA(IDIJ)
  77      1           *C1(M1,I-1,K,J)
  78  1008          CONTINUE
  79   108       CONTINUE
  80   109    CONTINUE
  81   110 CONTINUE
  82   111 IF (NBD .LT. L1) GO TO 115
  83       DO 114 J=2,IPPH
  84          JC = IPP2-J
  85          DO 113 K=1,L1
  86             DO 112 I=3,IDO,2
  87                M2 = M2S
  88                DO 1012 M1=1,M1D,IM1
  89                M2 = M2+IM2
  90                C1(M1,I-1,K,J) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
  91                C1(M1,I-1,K,JC) = CH(M2,I,K,J)-CH(M2,I,K,JC)
  92                C1(M1,I,K,J) = CH(M2,I,K,J)+CH(M2,I,K,JC)
  93                C1(M1,I,K,JC) = CH(M2,I-1,K,JC)-CH(M2,I-1,K,J)
  94  1012          CONTINUE
  95   112       CONTINUE
  96   113    CONTINUE
  97   114 CONTINUE
  98       GO TO 121
  99   115 DO 118 J=2,IPPH
 100          JC = IPP2-J
 101          DO 117 I=3,IDO,2
 102             DO 116 K=1,L1
 103                M2 = M2S
 104                DO 1016 M1=1,M1D,IM1
 105                M2 = M2+IM2
 106                C1(M1,I-1,K,J) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
 107                C1(M1,I-1,K,JC) = CH(M2,I,K,J)-CH(M2,I,K,JC)
 108                C1(M1,I,K,J) = CH(M2,I,K,J)+CH(M2,I,K,JC)
 109                C1(M1,I,K,JC) = CH(M2,I-1,K,JC)-CH(M2,I-1,K,J)
 110  1016          CONTINUE
 111   116       CONTINUE
 112   117    CONTINUE
 113   118 CONTINUE
 114       GO TO 121
 115   119 DO 120 IK=1,IDL1
 116          M2 = M2S
 117          DO 1020 M1=1,M1D,IM1
 118          M2 = M2+IM2
 119          C2(M1,IK,1) = CH2(M2,IK,1)
 120  1020    CONTINUE
 121   120 CONTINUE
 122   121 DO 123 J=2,IPPH
 123          JC = IPP2-J
 124          DO 122 K=1,L1
 125             M2 = M2S
 126             DO 1022 M1=1,M1D,IM1
 127             M2 = M2+IM2
 128             C1(M1,1,K,J) = CH(M2,1,K,J)+CH(M2,1,K,JC)
 129             C1(M1,1,K,JC) = CH(M2,1,K,JC)-CH(M2,1,K,J)
 130  1022       CONTINUE
 131   122    CONTINUE
 132   123 CONTINUE
 133 C
 134       AR1 = 1.
 135       AI1 = 0.
 136       DO 127 L=2,IPPH
 137          LC = IPP2-L
 138          AR1H = DCP*AR1-DSP*AI1
 139          AI1 = DCP*AI1+DSP*AR1
 140          AR1 = AR1H
 141          DO 124 IK=1,IDL1
 142             M2 = M2S
 143             DO 1024 M1=1,M1D,IM1
 144             M2 = M2+IM2
 145             CH2(M2,IK,L) = C2(M1,IK,1)+AR1*C2(M1,IK,2)
 146             CH2(M2,IK,LC) = AI1*C2(M1,IK,IP)
 147  1024       CONTINUE
 148   124    CONTINUE
 149          DC2 = AR1
 150          DS2 = AI1
 151          AR2 = AR1
 152          AI2 = AI1
 153          DO 126 J=3,IPPH
 154             JC = IPP2-J
 155             AR2H = DC2*AR2-DS2*AI2
 156             AI2 = DC2*AI2+DS2*AR2
 157             AR2 = AR2H
 158             DO 125 IK=1,IDL1
 159                M2 = M2S
 160                DO 1025 M1=1,M1D,IM1
 161                M2 = M2+IM2
 162                CH2(M2,IK,L) = CH2(M2,IK,L)+AR2*C2(M1,IK,J)
 163                CH2(M2,IK,LC) = CH2(M2,IK,LC)+AI2*C2(M1,IK,JC)
 164  1025          CONTINUE
 165   125       CONTINUE
 166   126    CONTINUE
 167   127 CONTINUE
 168       DO 129 J=2,IPPH
 169          DO 128 IK=1,IDL1
 170             M2 = M2S
 171             DO 1028 M1=1,M1D,IM1
 172             M2 = M2+IM2
 173             CH2(M2,IK,1) = CH2(M2,IK,1)+C2(M1,IK,J)
 174  1028       CONTINUE
 175   128    CONTINUE
 176   129 CONTINUE
 177 C
 178       IF (IDO .LT. L1) GO TO 132
 179       DO 131 K=1,L1
 180          DO 130 I=1,IDO
 181             M2 = M2S
 182             DO 1030 M1=1,M1D,IM1
 183             M2 = M2+IM2
 184             CC(M1,I,1,K) = CH(M2,I,K,1)
 185  1030       CONTINUE
 186   130    CONTINUE
 187   131 CONTINUE
 188       GO TO 135
 189   132 DO 134 I=1,IDO
 190          DO 133 K=1,L1
 191             M2 = M2S
 192             DO 1033 M1=1,M1D,IM1
 193             M2 = M2+IM2
 194             CC(M1,I,1,K) = CH(M2,I,K,1)
 195  1033       CONTINUE
 196   133    CONTINUE
 197   134 CONTINUE
 198   135 DO 137 J=2,IPPH
 199          JC = IPP2-J
 200          J2 = J+J
 201          DO 136 K=1,L1
 202             M2 = M2S
 203             DO 1036 M1=1,M1D,IM1
 204             M2 = M2+IM2
 205             CC(M1,IDO,J2-2,K) = CH(M2,1,K,J)
 206             CC(M1,1,J2-1,K) = CH(M2,1,K,JC)
 207  1036       CONTINUE
 208   136    CONTINUE
 209   137 CONTINUE
 210       IF (IDO .EQ. 1) RETURN
 211       IF (NBD .LT. L1) GO TO 141
 212       DO 140 J=2,IPPH
 213          JC = IPP2-J
 214          J2 = J+J
 215          DO 139 K=1,L1
 216             DO 138 I=3,IDO,2
 217                IC = IDP2-I
 218                M2 = M2S
 219                DO 1038 M1=1,M1D,IM1
 220                M2 = M2+IM2
 221                CC(M1,I-1,J2-1,K) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
 222                CC(M1,IC-1,J2-2,K) = CH(M2,I-1,K,J)-CH(M2,I-1,K,JC)
 223                CC(M1,I,J2-1,K) = CH(M2,I,K,J)+CH(M2,I,K,JC)
 224                CC(M1,IC,J2-2,K) = CH(M2,I,K,JC)-CH(M2,I,K,J)
 225  1038          CONTINUE
 226   138       CONTINUE
 227   139    CONTINUE
 228   140 CONTINUE
 229       RETURN
 230   141 DO 144 J=2,IPPH
 231          JC = IPP2-J
 232          J2 = J+J
 233          DO 143 I=3,IDO,2
 234             IC = IDP2-I
 235             DO 142 K=1,L1
 236                M2 = M2S
 237                DO 1042 M1=1,M1D,IM1
 238                M2 = M2+IM2
 239                CC(M1,I-1,J2-1,K) = CH(M2,I-1,K,J)+CH(M2,I-1,K,JC)
 240                CC(M1,IC-1,J2-2,K) = CH(M2,I-1,K,J)-CH(M2,I-1,K,JC)
 241                CC(M1,I,J2-1,K) = CH(M2,I,K,J)+CH(M2,I,K,JC)
 242                CC(M1,IC,J2-2,K) = CH(M2,I,K,JC)-CH(M2,I,K,J)
 243  1042          CONTINUE
 244   142       CONTINUE
 245   143    CONTINUE
 246   144 CONTINUE
 247       RETURN
 248       END