share/fftpack5/fortran/cmfgkb.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 CMFGKB (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 .OR. NA.EQ.1) GO TO 136
  79       DO 120 J=2,IPPH
  80          JC = IPP2-J
  81          DO 119 KI=1,LID
  82          DO 119 M1=1,M1D,IM1
  83             CHOLD1 = CC1(1,M1,KI,J)-CC1(2,M1,KI,JC)
  84             CHOLD2 = CC1(1,M1,KI,J)+CC1(2,M1,KI,JC)
  85             CC1(1,M1,KI,J) = CHOLD1
  86             CC1(2,M1,KI,JC) = CC1(2,M1,KI,J)-CC1(1,M1,KI,JC)
  87             CC1(2,M1,KI,J) = CC1(2,M1,KI,J)+CC1(1,M1,KI,JC)
  88             CC1(1,M1,KI,JC) = CHOLD2
  89   119    CONTINUE
  90   120 CONTINUE
  91       RETURN
  92   136 DO 137 KI=1,LID
  93          M2 = M2S
  94          DO 137 M1=1,M1D,IM1
  95          M2 = M2+IM2
  96          CH1(1,M2,KI,1) = CC1(1,M1,KI,1)
  97          CH1(2,M2,KI,1) = CC1(2,M1,KI,1)
  98   137 CONTINUE
  99       DO 135 J=2,IPPH
 100          JC = IPP2-J
 101          DO 134 KI=1,LID
 102          M2 = M2S
 103          DO 134 M1=1,M1D,IM1
 104          M2 = M2+IM2
 105             CH1(1,M2,KI,J) = CC1(1,M1,KI,J)-CC1(2,M1,KI,JC)
 106             CH1(1,M2,KI,JC) = CC1(1,M1,KI,J)+CC1(2,M1,KI,JC)
 107             CH1(2,M2,KI,JC) = CC1(2,M1,KI,J)-CC1(1,M1,KI,JC)
 108             CH1(2,M2,KI,J) = CC1(2,M1,KI,J)+CC1(1,M1,KI,JC)
 109   134    CONTINUE
 110   135 CONTINUE
 111       IF (IDO .EQ. 1) RETURN
 112       DO 131 I=1,IDO
 113          DO 130 K=1,L1
 114          M2 = M2S
 115          DO 130 M1=1,M1D,IM1
 116          M2 = M2+IM2
 117             CC(1,M1,K,1,I) = CH(1,M2,K,I,1)
 118             CC(2,M1,K,1,I) = CH(2,M2,K,I,1)
 119   130    CONTINUE
 120   131 CONTINUE
 121       DO 123 J=2,IP
 122          DO 122 K=1,L1
 123          M2 = M2S
 124          DO 122 M1=1,M1D,IM1
 125          M2 = M2+IM2
 126             CC(1,M1,K,J,1) = CH(1,M2,K,1,J)
 127             CC(2,M1,K,J,1) = CH(2,M2,K,1,J)
 128   122    CONTINUE
 129   123 CONTINUE
 130       DO 126 J=2,IP
 131          DO 125 I=2,IDO
 132             DO 124 K=1,L1
 133                M2 = M2S
 134                DO 124 M1=1,M1D,IM1
 135                M2 = M2+IM2
 136                CC(1,M1,K,J,I) = WA(I,J-1,1)*CH(1,M2,K,I,J)
 137      1                      -WA(I,J-1,2)*CH(2,M2,K,I,J)
 138                CC(2,M1,K,J,I) = WA(I,J-1,1)*CH(2,M2,K,I,J)
 139      1                      +WA(I,J-1,2)*CH(1,M2,K,I,J)
 140   124       CONTINUE
 141   125    CONTINUE
 142   126 CONTINUE
 143       RETURN
 144       END