!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
!
! FFTPACK 5.0
!
! Authors: Paul N. Swarztrauber and Richard A. Valent
!
! $Id: r1fgkf.f,v 1.2 2004/06/15 21:29:20 rodney Exp $
!
!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
SUBROUTINE R1FGKF (IDO,IP,L1,IDL1,CC,C1,C2,IN1, &
& CH,CH2,IN2,WA)
REAL CH(IN2,IDO,L1,IP) ,CC(IN1,IDO,IP,L1), &
& C1(IN1,IDO,L1,IP) ,C2(IN1,IDL1,IP), &
& CH2(IN2,IDL1,IP) ,WA(IDO)
!
TPI=2.*4.*ATAN(1.0)
ARG = TPI/FLOAT(IP)
DCP = COS(ARG)
DSP = SIN(ARG)
IPPH = (IP+1)/2
IPP2 = IP+2
IDP2 = IDO+2
NBD = (IDO-1)/2
IF (IDO .EQ. 1) GO TO 119
DO 101 IK=1,IDL1
CH2(1,IK,1) = C2(1,IK,1)
101 END DO
DO 103 J=2,IP
DO 102 K=1,L1
CH(1,1,K,J) = C1(1,1,K,J)
102 CONTINUE
103 END DO
IF (NBD .GT. L1) GO TO 107
IS = -IDO
DO 106 J=2,IP
IS = IS+IDO
IDIJ = IS
DO 105 I=3,IDO,2
IDIJ = IDIJ+2
DO 104 K=1,L1
CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J)+WA(IDIJ) &
& *C1(1,I,K,J)
CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J)-WA(IDIJ) &
& *C1(1,I-1,K,J)
104 CONTINUE
105 CONTINUE
106 END DO
GO TO 111
107 IS = -IDO
DO 110 J=2,IP
IS = IS+IDO
DO 109 K=1,L1
IDIJ = IS
DO 108 I=3,IDO,2
IDIJ = IDIJ+2
CH(1,I-1,K,J) = WA(IDIJ-1)*C1(1,I-1,K,J)+WA(IDIJ) &
& *C1(1,I,K,J)
CH(1,I,K,J) = WA(IDIJ-1)*C1(1,I,K,J)-WA(IDIJ) &
& *C1(1,I-1,K,J)
108 CONTINUE
109 CONTINUE
110 END DO
111 IF (NBD .LT. L1) GO TO 115
DO 114 J=2,IPPH
JC = IPP2-J
DO 113 K=1,L1
DO 112 I=3,IDO,2
C1(1,I-1,K,J) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
C1(1,I-1,K,JC) = CH(1,I,K,J)-CH(1,I,K,JC)
C1(1,I,K,J) = CH(1,I,K,J)+CH(1,I,K,JC)
C1(1,I,K,JC) = CH(1,I-1,K,JC)-CH(1,I-1,K,J)
112 CONTINUE
113 CONTINUE
114 END DO
GO TO 121
115 DO 118 J=2,IPPH
JC = IPP2-J
DO 117 I=3,IDO,2
DO 116 K=1,L1
C1(1,I-1,K,J) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
C1(1,I-1,K,JC) = CH(1,I,K,J)-CH(1,I,K,JC)
C1(1,I,K,J) = CH(1,I,K,J)+CH(1,I,K,JC)
C1(1,I,K,JC) = CH(1,I-1,K,JC)-CH(1,I-1,K,J)
116 CONTINUE
117 CONTINUE
118 END DO
GO TO 121
119 DO 120 IK=1,IDL1
C2(1,IK,1) = CH2(1,IK,1)
120 END DO
121 DO 123 J=2,IPPH
JC = IPP2-J
DO 122 K=1,L1
C1(1,1,K,J) = CH(1,1,K,J)+CH(1,1,K,JC)
C1(1,1,K,JC) = CH(1,1,K,JC)-CH(1,1,K,J)
122 CONTINUE
123 END DO
!
AR1 = 1.
AI1 = 0.
DO 127 L=2,IPPH
LC = IPP2-L
AR1H = DCP*AR1-DSP*AI1
AI1 = DCP*AI1+DSP*AR1
AR1 = AR1H
DO 124 IK=1,IDL1
CH2(1,IK,L) = C2(1,IK,1)+AR1*C2(1,IK,2)
CH2(1,IK,LC) = AI1*C2(1,IK,IP)
124 CONTINUE
DC2 = AR1
DS2 = AI1
AR2 = AR1
AI2 = AI1
DO 126 J=3,IPPH
JC = IPP2-J
AR2H = DC2*AR2-DS2*AI2
AI2 = DC2*AI2+DS2*AR2
AR2 = AR2H
DO 125 IK=1,IDL1
CH2(1,IK,L) = CH2(1,IK,L)+AR2*C2(1,IK,J)
CH2(1,IK,LC) = CH2(1,IK,LC)+AI2*C2(1,IK,JC)
125 CONTINUE
126 CONTINUE
127 END DO
DO 129 J=2,IPPH
DO 128 IK=1,IDL1
CH2(1,IK,1) = CH2(1,IK,1)+C2(1,IK,J)
128 CONTINUE
129 END DO
!
IF (IDO .LT. L1) GO TO 132
DO 131 K=1,L1
DO 130 I=1,IDO
CC(1,I,1,K) = CH(1,I,K,1)
130 CONTINUE
131 END DO
GO TO 135
132 DO 134 I=1,IDO
DO 133 K=1,L1
CC(1,I,1,K) = CH(1,I,K,1)
133 CONTINUE
134 END DO
135 DO 137 J=2,IPPH
JC = IPP2-J
J2 = J+J
DO 136 K=1,L1
CC(1,IDO,J2-2,K) = CH(1,1,K,J)
CC(1,1,J2-1,K) = CH(1,1,K,JC)
136 CONTINUE
137 END DO
IF (IDO .EQ. 1) RETURN
IF (NBD .LT. L1) GO TO 141
DO 140 J=2,IPPH
JC = IPP2-J
J2 = J+J
DO 139 K=1,L1
DO 138 I=3,IDO,2
IC = IDP2-I
CC(1,I-1,J2-1,K) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J)-CH(1,I-1,K,JC)
CC(1,I,J2-1,K) = CH(1,I,K,J)+CH(1,I,K,JC)
CC(1,IC,J2-2,K) = CH(1,I,K,JC)-CH(1,I,K,J)
138 CONTINUE
139 CONTINUE
140 END DO
RETURN
141 DO 144 J=2,IPPH
JC = IPP2-J
J2 = J+J
DO 143 I=3,IDO,2
IC = IDP2-I
DO 142 K=1,L1
CC(1,I-1,J2-1,K) = CH(1,I-1,K,J)+CH(1,I-1,K,JC)
CC(1,IC-1,J2-2,K) = CH(1,I-1,K,J)-CH(1,I-1,K,JC)
CC(1,I,J2-1,K) = CH(1,I,K,J)+CH(1,I,K,JC)
CC(1,IC,J2-2,K) = CH(1,I,K,JC)-CH(1,I,K,J)
142 CONTINUE
143 CONTINUE
144 END DO
RETURN
END