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