RADFGM.inc
References to this file elsewhere.
1 C***********************************************************************
2 SUBROUTINE RADFGM (INC,LOT,IDO,IP,L1,IDL1,CC,C1,C2,CH,CH2,WA)
3 DIMENSION CH(INC,IDO,L1,IP) ,CC(INC,IDO,IP,L1)
4 1 ,C1(INC,IDO,L1,IP) ,C2(INC,IDL1,IP)
5 2 ,CH2(INC,IDL1,IP) ,WA(*)
6 REAL*8 ARG,DCP,DSP,AR1,AI1,AR1H,DC2,DS2,AR2,AI2,AR2H,TPI
7 DATA TPI /6.283185307179590/
8 C
9 ARG = TPI/IP
10 DCP = COS(ARG)
11 DSP = SIN(ARG)
12 IPPH = (IP+1)/2
13 IPP2 = IP+2
14 C IPPHC = IPP2-IPPH
15 C IPPH2= 2*IPPH
16 IDP2 = IDO+2
17 C
18 IF (IDO .EQ. 1) GO TO 1000
19 DO 101 IK=1,IDL1
20 DO 101 L=1,LOT
21 101 CH2(L,IK,1) = C2(L,IK,1)
22 DO 104 J=2,IP
23 DO 104 K=1,L1
24 DO 103 L=1,LOT
25 103 CH(L,1,K,J) = C1(L,1,K,J)
26 104 CONTINUE
27 IS = -IDO
28 *VOPTION NOFVAL
29 DO 116 J=2,IP
30 IS = IS+IDO
31 DO 115 K=1,L1
32 *VOPTION NOFVAL
33 DO 114 I=3,IDO,2
34 IDIJ = IS+I-1
35 DO 113 L=1,LOT
36 CH(L,I-1,K,J) =
37 * WA(IDIJ-1)*C1(L,I-1,K,J)+WA(IDIJ)*C1(L,I ,K,J)
38 CH(L,I ,K,J) =
39 * WA(IDIJ-1)*C1(L,I ,K,J)-WA(IDIJ)*C1(L,I-1,K,J)
40 113 CONTINUE
41 114 CONTINUE
42 115 CONTINUE
43 116 CONTINUE
44 *VOPTION NOFVAL
45 DO 120 J=2,IPPH
46 JC = IPP2-J
47 DO 119 K=1,L1
48 DO 119 I=3,IDO,2
49 DO 118 L=1,LOT
50 C1(L,I-1,K,J ) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
51 C1(L,I ,K,J ) = CH(L,I ,K,J )+CH(L,I ,K,JC)
52 C1(L,I-1,K,JC) = CH(L,I ,K,J )-CH(L,I ,K,JC)
53 C1(L,I ,K,JC) = CH(L,I-1,K,JC)-CH(L,I-1,K,J )
54 118 CONTINUE
55 119 CONTINUE
56 120 CONTINUE
57 GO TO 2000
58 C
59 1000 CONTINUE
60 DO 122 IK=1,IDL1
61 DO 122 L=1,LOT
62 122 C2(L,IK,1) = CH2(L,IK,1)
63 C
64 2000 CONTINUE
65 *VOPTION NOFVAL
66 DO 125 J=2,IPPH
67 JC = IPP2-J
68 DO 124 K=1,L1
69 DO 124 L=1,LOT
70 C1(L,1,K,J ) = CH(L,1,K,J )+CH(L,1,K,JC)
71 C1(L,1,K,JC) = CH(L,1,K,JC)-CH(L,1,K,J )
72 124 CONTINUE
73 125 CONTINUE
74 AR1 = 1.0
75 AI1 = 0.0
76 *VOPTION NOFVAL
77 DO 134 M=2,IPPH
78 MC = IPP2-M
79 AR1H = DCP*AR1-DSP*AI1
80 AI1 = DCP*AI1+DSP*AR1
81 AR1 = AR1H
82 DO 131 IK=1,IDL1
83 DO 131 L=1,LOT
84 CH2(L,IK,M ) = C2(L,IK,1)+AR1*C2(L,IK, 2)
85 CH2(L,IK,MC) = AI1*C2(L,IK,IP)
86 131 CONTINUE
87 DC2 = AR1
88 DS2 = AI1
89 AR2 = AR1
90 AI2 = AI1
91 *VOPTION NOFVAL
92 DO 133 J=3,IPPH
93 JC = IPP2-J
94 AR2H = DC2*AR2-DS2*AI2
95 AI2 = DC2*AI2+DS2*AR2
96 AR2 = AR2H
97 DO 132 IK=1,IDL1
98 DO 132 L=1,LOT
99 CH2(L,IK,M ) = CH2(L,IK,M )+AR2*C2(L,IK,J )
100 CH2(L,IK,MC) = CH2(L,IK,MC)+AI2*C2(L,IK,JC)
101 132 CONTINUE
102 133 CONTINUE
103 134 CONTINUE
104 DO 137 J=2,IPPH
105 DO 137 IK=1,IDL1
106 DO 136 L=1,LOT
107 136 CH2(L,IK,1) = CH2(L,IK,1)+C2(L,IK,J)
108 137 CONTINUE
109 DO 148 K=1,L1
110 DO 148 I=1,IDO
111 DO 147 L=1,LOT
112 147 CC(L,I,1,K) = CH(L,I,K,1)
113 148 CONTINUE
114 *VOPTION NOFVAL
115 DO 159 J=2,IPPH
116 JC = IPP2-J
117 J2 = J+J
118 DO 158 K=1,L1
119 DO 158 L=1,LOT
120 CC(L,IDO,J2-2,K) = CH(L,1,K,J )
121 CC(L, 1,J2-1,K) = CH(L,1,K,JC)
122 158 CONTINUE
123 159 CONTINUE
124 IF (IDO .EQ. 1) RETURN
125 *VOPTION NOFVAL
126 DO 167 J=2,IPPH
127 JC = IPP2-J
128 J2 = J+J
129 DO 166 K=1,L1
130 *VOPTION NOFVAL
131 DO 165 I=3,IDO,2
132 IC = IDP2-I
133 DO 164 L=1,LOT
134 CC(L,I -1,J2-1,K) = CH(L,I-1,K,J )+CH(L,I-1,K,JC)
135 CC(L,I ,J2-1,K) = CH(L,I ,K,J )+CH(L,I ,K,JC)
136 CC(L,IC-1,J2-2,K) = CH(L,I-1,K,J )-CH(L,I-1,K,JC)
137 CC(L,IC ,J2-2,K) = CH(L,I ,K,JC)-CH(L,I ,K,J )
138 164 CONTINUE
139 165 CONTINUE
140 166 CONTINUE
141 167 CONTINUE
142 RETURN
143 END SUBROUTINE RADFGM
144