share/fftpack5/fortran/cmfgkf.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 CMFGKF (LOT,IDO,IP,L1,LID,NA,CC,CC1,IM1,IN1,
  12      1                                      CH,CH1,IM2,IN2,WA)
  13       REAL       CH(2,IN2,L1,IDO,IP) ,CC(2,IN1,L1,IP,IDO),
  14      1                CC1(2,IN1,LID,IP)    ,CH1(2,IN2,LID,IP)  ,
  15      2                WA(IDO,IP-1,2)
  16 C
  17 C FFTPACK 5.0 auxiliary routine
  18 C
  19       M1D = (LOT-1)*IM1+1
  20       M2S = 1-IM2
  21       IPP2 = IP+2
  22       IPPH = (IP+1)/2
  23       DO 110 KI=1,LID
  24          M2 = M2S
  25          DO 110 M1=1,M1D,IM1
  26          M2 = M2+IM2
  27          CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
  28          CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
  29   110 CONTINUE
  30       DO 111 J=2,IPPH
  31          JC = IPP2-J
  32          DO 112 KI=1,LID
  33          M2 = M2S
  34          DO 112 M1=1,M1D,IM1
  35          M2 = M2+IM2
  36             CH1(1,M2,KI,J) =  CC1(1,M1,KI,J)+CC1(1,M1,KI,JC)
  37             CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)-CC1(1,M1,KI,JC)
  38             CH1(2,M2,KI,J) =  CC1(2,M1,KI,J)+CC1(2,M1,KI,JC)
  39             CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(2,M1,KI,JC)
  40   112    CONTINUE
  41   111 CONTINUE
  42       DO 118 J=2,IPPH
  43          DO 117 KI=1,LID
  44          M2 = M2S
  45          DO 117 M1=1,M1D,IM1
  46          M2 = M2+IM2
  47             CC1(1,M1,KI,1) = CC1(1,M1,KI,1)+CH1(1,M2,KI,J)
  48             CC1(2,M1,KI,1) = CC1(2,M1,KI,1)+CH1(2,M2,KI,J)
  49   117    CONTINUE
  50   118 CONTINUE
  51       DO 116 L=2,IPPH
  52          LC = IPP2-L
  53          DO 113 KI=1,LID
  54          M2 = M2S
  55          DO 113 M1=1,M1D,IM1
  56          M2 = M2+IM2
  57             CC1(1,M1,KI,L) = CH1(1,M2,KI,1)+WA(1,L-1,1)*CH1(1,M2,KI,2)
  58             CC1(1,M1,KI,LC) = -WA(1,L-1,2)*CH1(1,M2,KI,IP)
  59             CC1(2,M1,KI,L) = CH1(2,M2,KI,1)+WA(1,L-1,1)*CH1(2,M2,KI,2)
  60             CC1(2,M1,KI,LC) = -WA(1,L-1,2)*CH1(2,M2,KI,IP)
  61   113    CONTINUE
  62          DO 115 J=3,IPPH
  63             JC = IPP2-J
  64             IDLJ = MOD((L-1)*(J-1),IP)
  65             WAR = WA(1,IDLJ,1)
  66             WAI = -WA(1,IDLJ,2)
  67             DO 114 KI=1,LID
  68                M2 = M2S
  69                DO 114 M1=1,M1D,IM1
  70                M2 = M2+IM2
  71                CC1(1,M1,KI,L) = CC1(1,M1,KI,L)+WAR*CH1(1,M2,KI,J)
  72                CC1(1,M1,KI,LC) = CC1(1,M1,KI,LC)+WAI*CH1(1,M2,KI,JC)
  73                CC1(2,M1,KI,L) = CC1(2,M1,KI,L)+WAR*CH1(2,M2,KI,J)
  74                CC1(2,M1,KI,LC) = CC1(2,M1,KI,LC)+WAI*CH1(2,M2,KI,JC)
  75   114       CONTINUE
  76   115    CONTINUE
  77   116 CONTINUE
  78       IF (IDO .GT. 1) GO TO 136
  79       SN = 1./REAL(IP*L1)
  80       IF (NA .EQ. 1) GO TO 146
  81       DO 149 KI=1,LID
  82          M2 = M2S
  83          DO 149 M1=1,M1D,IM1
  84          M2 = M2+IM2
  85          CC1(1,M1,KI,1) = SN*CC1(1,M1,KI,1)
  86          CC1(2,M1,KI,1) = SN*CC1(2,M1,KI,1)
  87   149 CONTINUE
  88       DO 120 J=2,IPPH
  89          JC = IPP2-J
  90          DO 119 KI=1,LID
  91          DO 119 M1=1,M1D,IM1
  92             CHOLD1 = SN*(CC1(1,M1,KI,J)-CC1(2,M1,KI,JC))
  93             CHOLD2 = SN*(CC1(1,M1,KI,J)+CC1(2,M1,KI,JC))
  94             CC1(1,M1,KI,J) = CHOLD1
  95             CC1(2,M1,KI,JC) = SN*(CC1(2,M1,KI,J)-CC1(1,M1,KI,JC))
  96             CC1(2,M1,KI,J) = SN*(CC1(2,M1,KI,J)+CC1(1,M1,KI,JC))
  97             CC1(1,M1,KI,JC) = CHOLD2
  98   119    CONTINUE
  99   120 CONTINUE
 100       RETURN
 101   146 DO 147 KI=1,LID
 102          M2 = M2S
 103          DO 147 M1=1,M1D,IM1
 104          M2 = M2+IM2
 105          CH1(1,M2,KI,1) = SN*CC1(1,M1,KI,1)
 106          CH1(2,M2,KI,1) = SN*CC1(2,M1,KI,1)
 107   147 CONTINUE
 108       DO 145 J=2,IPPH
 109          JC = IPP2-J
 110          DO 144 KI=1,LID
 111          M2 = M2S
 112          DO 144 M1=1,M1D,IM1
 113          M2 = M2+IM2
 114             CH1(1,M2,KI,J) = SN*(CC1(1,M1,KI,J)-CC1(2,M1,KI,JC))
 115             CH1(2,M2,KI,J) = SN*(CC1(2,M1,KI,J)+CC1(1,M1,KI,JC))
 116             CH1(1,M2,KI,JC) = SN*(CC1(1,M1,KI,J)+CC1(2,M1,KI,JC))
 117             CH1(2,M2,KI,JC) = SN*(CC1(2,M1,KI,J)-CC1(1,M1,KI,JC))
 118   144    CONTINUE
 119   145 CONTINUE
 120       RETURN
 121   136 DO 137 KI=1,LID
 122          M2 = M2S
 123          DO 137 M1=1,M1D,IM1
 124          M2 = M2+IM2
 125          CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
 126          CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
 127   137 CONTINUE
 128       DO 135 J=2,IPPH
 129          JC = IPP2-J
 130          DO 134 KI=1,LID
 131          M2 = M2S
 132          DO 134 M1=1,M1D,IM1
 133          M2 = M2+IM2
 134             CH1(1,M2,KI,J) = CC1(1,M1,KI,J)-CC1(2,M1,KI,JC)
 135             CH1(2,M2,KI,J) = CC1(2,M1,KI,J)+CC1(1,M1,KI,JC)
 136             CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)+CC1(2,M1,KI,JC)
 137             CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(1,M1,KI,JC)
 138   134    CONTINUE
 139   135 CONTINUE
 140       DO 131 I=1,IDO
 141          DO 130 K=1,L1
 142          M2 = M2S
 143          DO 130 M1=1,M1D,IM1
 144          M2 = M2+IM2
 145             CC(1,M1,K,1,I) = CH(1,M2,K,I,1)
 146             CC(2,M1,K,1,I) = CH(2,M2,K,I,1)
 147   130    CONTINUE
 148   131 CONTINUE
 149       DO 123 J=2,IP
 150          DO 122 K=1,L1
 151          M2 = M2S
 152          DO 122 M1=1,M1D,IM1
 153          M2 = M2+IM2
 154             CC(1,M1,K,J,1) = CH(1,M2,K,1,J)
 155             CC(2,M1,K,J,1) = CH(2,M2,K,1,J)
 156   122    CONTINUE
 157   123 CONTINUE
 158       DO 126 J=2,IP
 159          DO 125 I=2,IDO
 160             DO 124 K=1,L1
 161                M2 = M2S
 162                DO 124 M1=1,M1D,IM1
 163                M2 = M2+IM2
 164                CC(1,M1,K,J,I) = WA(I,J-1,1)*CH(1,M2,K,I,J)
 165      1                      +WA(I,J-1,2)*CH(2,M2,K,I,J)
 166                CC(2,M1,K,J,I) = WA(I,J-1,1)*CH(2,M2,K,I,J)
 167      1                      -WA(I,J-1,2)*CH(1,M2,K,I,J)
 168   124       CONTINUE
 169   125    CONTINUE
 170   126 CONTINUE
 171       RETURN
 172       END