share/fftpack5/fortran/c1fgkb.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 C1FGKB (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 .OR. NA.EQ.1) GO TO 136
  62       DO 120 J=2,IPPH
  63          JC = IPP2-J
  64          DO 119 KI=1,LID
  65             CHOLD1 = CC1(1,KI,J)-CC1(2,KI,JC)
  66             CHOLD2 = CC1(1,KI,J)+CC1(2,KI,JC)
  67             CC1(1,KI,J) = CHOLD1
  68             CC1(2,KI,JC) = CC1(2,KI,J)-CC1(1,KI,JC)
  69             CC1(2,KI,J) = CC1(2,KI,J)+CC1(1,KI,JC)
  70             CC1(1,KI,JC) = CHOLD2
  71   119    CONTINUE
  72   120 CONTINUE
  73       RETURN
  74   136 DO 137 KI=1,LID
  75          CH1(1,KI,1) = CC1(1,KI,1)
  76          CH1(2,KI,1) = CC1(2,KI,1)
  77   137 CONTINUE
  78       DO 135 J=2,IPPH
  79          JC = IPP2-J
  80          DO 134 KI=1,LID
  81             CH1(1,KI,J) = CC1(1,KI,J)-CC1(2,KI,JC)
  82             CH1(1,KI,JC) = CC1(1,KI,J)+CC1(2,KI,JC)
  83             CH1(2,KI,JC) = CC1(2,KI,J)-CC1(1,KI,JC)
  84             CH1(2,KI,J) = CC1(2,KI,J)+CC1(1,KI,JC)
  85   134    CONTINUE
  86   135 CONTINUE
  87       IF (IDO .EQ. 1) RETURN
  88       DO 131 I=1,IDO
  89          DO 130 K=1,L1
  90             CC(1,K,1,I) = CH(1,K,I,1)
  91             CC(2,K,1,I) = CH(2,K,I,1)
  92   130    CONTINUE
  93   131 CONTINUE
  94       DO 123 J=2,IP
  95          DO 122 K=1,L1
  96             CC(1,K,J,1) = CH(1,K,1,J)
  97             CC(2,K,J,1) = CH(2,K,1,J)
  98   122    CONTINUE
  99   123 CONTINUE
 100       DO 126 J=2,IP
 101          DO 125 I=2,IDO
 102             DO 124 K=1,L1
 103                CC(1,K,J,I) = WA(I,J-1,1)*CH(1,K,I,J)
 104      1                      -WA(I,J-1,2)*CH(2,K,I,J)
 105                CC(2,K,J,I) = WA(I,J-1,1)*CH(2,K,I,J)
 106      1                      +WA(I,J-1,2)*CH(1,K,I,J)
 107   124       CONTINUE
 108   125    CONTINUE
 109   126 CONTINUE
 110       RETURN
 111       END