SUBROUTINE VRADFG (MP,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,MDIMC,WA)
C
C VRFFTPK, VERSION 1, AUGUST 1985
C
DIMENSION CH(MDIMC,IDO,L1,IP) ,CC(MDIMC,IDO,IP,L1) ,
1 C1(MDIMC,IDO,L1,IP) ,C2(MDIMC,IDL1,IP),
2 CH2(MDIMC,IDL1,IP) ,WA(IDO)
TPI=2.*PIMACH(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
DO 1001 M=1,MP
CH2(M,IK,1) = C2(M,IK,1)
1001 CONTINUE
101 CONTINUE
DO 103 J=2,IP
DO 102 K=1,L1
DO 1002 M=1,MP
CH(M,1,K,J) = C1(M,1,K,J)
1002 CONTINUE
102 CONTINUE
103 CONTINUE
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
DO 1004 M=1,MP
CH(M,I-1,K,J) = WA(IDIJ-1)*C1(M,I-1,K,J)+WA(IDIJ)
1 *C1(M,I,K,J)
CH(M,I,K,J) = WA(IDIJ-1)*C1(M,I,K,J)-WA(IDIJ)
1 *C1(M,I-1,K,J)
1004 CONTINUE
104 CONTINUE
105 CONTINUE
106 CONTINUE
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
DO 1008 M=1,MP
CH(M,I-1,K,J) = WA(IDIJ-1)*C1(M,I-1,K,J)+WA(IDIJ)
1 *C1(M,I,K,J)
CH(M,I,K,J) = WA(IDIJ-1)*C1(M,I,K,J)-WA(IDIJ)
1 *C1(M,I-1,K,J)
1008 CONTINUE
108 CONTINUE
109 CONTINUE
110 CONTINUE
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
DO 1012 M=1,MP
C1(M,I-1,K,J) = CH(M,I-1,K,J)+CH(M,I-1,K,JC)
C1(M,I-1,K,JC) = CH(M,I,K,J)-CH(M,I,K,JC)
C1(M,I,K,J) = CH(M,I,K,J)+CH(M,I,K,JC)
C1(M,I,K,JC) = CH(M,I-1,K,JC)-CH(M,I-1,K,J)
1012 CONTINUE
112 CONTINUE
113 CONTINUE
114 CONTINUE
GO TO 121
115 DO 118 J=2,IPPH
JC = IPP2-J
DO 117 I=3,IDO,2
DO 116 K=1,L1
DO 1016 M=1,MP
C1(M,I-1,K,J) = CH(M,I-1,K,J)+CH(M,I-1,K,JC)
C1(M,I-1,K,JC) = CH(M,I,K,J)-CH(M,I,K,JC)
C1(M,I,K,J) = CH(M,I,K,J)+CH(M,I,K,JC)
C1(M,I,K,JC) = CH(M,I-1,K,JC)-CH(M,I-1,K,J)
1016 CONTINUE
116 CONTINUE
117 CONTINUE
118 CONTINUE
GO TO 121
119 DO 120 IK=1,IDL1
DO 1020 M=1,MP
C2(M,IK,1) = CH2(M,IK,1)
1020 CONTINUE
120 CONTINUE
121 DO 123 J=2,IPPH
JC = IPP2-J
DO 122 K=1,L1
DO 1022 M=1,MP
C1(M,1,K,J) = CH(M,1,K,J)+CH(M,1,K,JC)
C1(M,1,K,JC) = CH(M,1,K,JC)-CH(M,1,K,J)
1022 CONTINUE
122 CONTINUE
123 CONTINUE
C
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
DO 1024 M=1,MP
CH2(M,IK,L) = C2(M,IK,1)+AR1*C2(M,IK,2)
CH2(M,IK,LC) = AI1*C2(M,IK,IP)
1024 CONTINUE
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
DO 1025 M=1,MP
CH2(M,IK,L) = CH2(M,IK,L)+AR2*C2(M,IK,J)
CH2(M,IK,LC) = CH2(M,IK,LC)+AI2*C2(M,IK,JC)
1025 CONTINUE
125 CONTINUE
126 CONTINUE
127 CONTINUE
DO 129 J=2,IPPH
DO 128 IK=1,IDL1
DO 1028 M=1,MP
CH2(M,IK,1) = CH2(M,IK,1)+C2(M,IK,J)
1028 CONTINUE
128 CONTINUE
129 CONTINUE
C
IF (IDO .LT. L1) GO TO 132
DO 131 K=1,L1
DO 130 I=1,IDO
DO 1030 M=1,MP
CC(M,I,1,K) = CH(M,I,K,1)
1030 CONTINUE
130 CONTINUE
131 CONTINUE
GO TO 135
132 DO 134 I=1,IDO
DO 133 K=1,L1
DO 1033 M=1,MP
CC(M,I,1,K) = CH(M,I,K,1)
1033 CONTINUE
133 CONTINUE
134 CONTINUE
135 DO 137 J=2,IPPH
JC = IPP2-J
J2 = J+J
DO 136 K=1,L1
DO 1036 M=1,MP
CC(M,IDO,J2-2,K) = CH(M,1,K,J)
CC(M,1,J2-1,K) = CH(M,1,K,JC)
1036 CONTINUE
136 CONTINUE
137 CONTINUE
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
DO 1038 M=1,MP
CC(M,I-1,J2-1,K) = CH(M,I-1,K,J)+CH(M,I-1,K,JC)
CC(M,IC-1,J2-2,K) = CH(M,I-1,K,J)-CH(M,I-1,K,JC)
CC(M,I,J2-1,K) = CH(M,I,K,J)+CH(M,I,K,JC)
CC(M,IC,J2-2,K) = CH(M,I,K,JC)-CH(M,I,K,J)
1038 CONTINUE
138 CONTINUE
139 CONTINUE
140 CONTINUE
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
DO 1042 M=1,MP
CC(M,I-1,J2-1,K) = CH(M,I-1,K,J)+CH(M,I-1,K,JC)
CC(M,IC-1,J2-2,K) = CH(M,I-1,K,J)-CH(M,I-1,K,JC)
CC(M,I,J2-1,K) = CH(M,I,K,J)+CH(M,I,K,JC)
CC(M,IC,J2-2,K) = CH(M,I,K,JC)-CH(M,I,K,J)
1042 CONTINUE
142 CONTINUE
143 CONTINUE
144 CONTINUE
RETURN
END
.
