C***********************************************************************
SUBROUTINE RADFGM (INC,LOT,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
DIMENSION CH(INC,IDO,L1,IP) ,CC(INC,IDO,IP,L1)
1 ,C1(INC,IDO,L1,IP) ,C2(INC,IDL1,IP)
2 ,CH2(INC,IDL1,IP) ,WA(*)
REAL*8 ARG,DCP,DSP,AR1,AI1,AR1H,DC2,DS2,AR2,AI2,AR2H,TPI
DATA TPI /6.283185307179590/
C
ARG = TPI/IP
DCP = COS(ARG)
DSP = SIN(ARG)
IPPH = (IP+1)/2
IPP2 = IP+2
C IPPHC = IPP2-IPPH
C IPPH2= 2*IPPH
IDP2 = IDO+2
C
IF (IDO .EQ. 1) GO TO 1000
DO 101 IK=1,IDL1
DO 101 L=1,LOT
101 CH2(L,IK,1) = C2(L,IK,1)
DO 104 J=2,IP
DO 104 K=1,L1
DO 103 L=1,LOT
103 CH(L,1,K,J) = C1(L,1,K,J)
104 CONTINUE
IS = -IDO
*VOPTION NOFVAL
DO 116 J=2,IP
IS = IS+IDO
DO 115 K=1,L1
*VOPTION NOFVAL
DO 114 I=3,IDO,2
IDIJ = IS+I-1
DO 113 L=1,LOT
CH(L,I-1,K,J) =
* WA(IDIJ-1)*C1(L,I-1,K,J)+WA(IDIJ)*C1(L,I ,K,J)
CH(L,I ,K,J) =
* WA(IDIJ-1)*C1(L,I ,K,J)-WA(IDIJ)*C1(L,I-1,K,J)
113 CONTINUE
114 CONTINUE
115 CONTINUE
116 CONTINUE
*VOPTION NOFVAL
DO 120 J=2,IPPH
JC = IPP2-J
DO 119 K=1,L1
DO 119 I=3,IDO,2
DO 118 L=1,LOT
C1(L,I-1,K,J ) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
C1(L,I ,K,J ) = CH(L,I ,K,J )+CH(L,I ,K,JC)
C1(L,I-1,K,JC) = CH(L,I ,K,J )-CH(L,I ,K,JC)
C1(L,I ,K,JC) = CH(L,I-1,K,JC)-CH(L,I-1,K,J )
118 CONTINUE
119 CONTINUE
120 CONTINUE
GO TO 2000
C
1000 CONTINUE
DO 122 IK=1,IDL1
DO 122 L=1,LOT
122 C2(L,IK,1) = CH2(L,IK,1)
C
2000 CONTINUE
*VOPTION NOFVAL
DO 125 J=2,IPPH
JC = IPP2-J
DO 124 K=1,L1
DO 124 L=1,LOT
C1(L,1,K,J ) = CH(L,1,K,J )+CH(L,1,K,JC)
C1(L,1,K,JC) = CH(L,1,K,JC)-CH(L,1,K,J )
124 CONTINUE
125 CONTINUE
AR1 = 1.0
AI1 = 0.0
*VOPTION NOFVAL
DO 134 M=2,IPPH
MC = IPP2-M
AR1H = DCP*AR1-DSP*AI1
AI1 = DCP*AI1+DSP*AR1
AR1 = AR1H
DO 131 IK=1,IDL1
DO 131 L=1,LOT
CH2(L,IK,M ) = C2(L,IK,1)+AR1*C2(L,IK, 2)
CH2(L,IK,MC) = AI1*C2(L,IK,IP)
131 CONTINUE
DC2 = AR1
DS2 = AI1
AR2 = AR1
AI2 = AI1
*VOPTION NOFVAL
DO 133 J=3,IPPH
JC = IPP2-J
AR2H = DC2*AR2-DS2*AI2
AI2 = DC2*AI2+DS2*AR2
AR2 = AR2H
DO 132 IK=1,IDL1
DO 132 L=1,LOT
CH2(L,IK,M ) = CH2(L,IK,M )+AR2*C2(L,IK,J )
CH2(L,IK,MC) = CH2(L,IK,MC)+AI2*C2(L,IK,JC)
132 CONTINUE
133 CONTINUE
134 CONTINUE
DO 137 J=2,IPPH
DO 137 IK=1,IDL1
DO 136 L=1,LOT
136 CH2(L,IK,1) = CH2(L,IK,1)+C2(L,IK,J)
137 CONTINUE
DO 148 K=1,L1
DO 148 I=1,IDO
DO 147 L=1,LOT
147 CC(L,I,1,K) = CH(L,I,K,1)
148 CONTINUE
*VOPTION NOFVAL
DO 159 J=2,IPPH
JC = IPP2-J
J2 = J+J
DO 158 K=1,L1
DO 158 L=1,LOT
CC(L,IDO,J2-2,K) = CH(L,1,K,J )
CC(L, 1,J2-1,K) = CH(L,1,K,JC)
158 CONTINUE
159 CONTINUE
IF (IDO .EQ. 1) RETURN
*VOPTION NOFVAL
DO 167 J=2,IPPH
JC = IPP2-J
J2 = J+J
DO 166 K=1,L1
*VOPTION NOFVAL
DO 165 I=3,IDO,2
IC = IDP2-I
DO 164 L=1,LOT
CC(L,I -1,J2-1,K) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
CC(L,I ,J2-1,K) = CH(L,I ,K,J )+CH(L,I ,K,JC)
CC(L,IC-1,J2-2,K) = CH(L,I-1,K,J )-CH(L,I-1,K,JC)
CC(L,IC ,J2-2,K) = CH(L,I ,K,JC)-CH(L,I ,K,J )
164 CONTINUE
165 CONTINUE
166 CONTINUE
167 CONTINUE
RETURN
END SUBROUTINE RADFGM