1 subroutine cmf4kf ( lot, ido, l1, na, cc, im1, in1, ch, im2, in2, wa )
3 !*****************************************************************************80
5 !! CMF4KF is an FFTPACK5 auxiliary routine.
8 ! Copyright (C) 1995-2004, Scientific Computing Division,
9 ! University Corporation for Atmospheric Research
23 ! Vectorizing the Fast Fourier Transforms,
24 ! in Parallel Computations,
25 ! edited by G. Rodrigue,
26 ! Academic Press, 1982.
29 ! Fast Fourier Transform Algorithms for Vector Computers,
30 ! Parallel Computing, pages 45-63, 1984.
36 integer ( kind = 4 ) ido
37 integer ( kind = 4 ) in1
38 integer ( kind = 4 ) in2
39 integer ( kind = 4 ) l1
41 real ( kind = 4 ) cc(2,in1,l1,ido,4)
42 real ( kind = 4 ) ch(2,in2,l1,4,ido)
49 integer ( kind = 4 ) i
50 integer ( kind = 4 ) im1
51 integer ( kind = 4 ) im2
52 integer ( kind = 4 ) k
53 integer ( kind = 4 ) lot
54 integer ( kind = 4 ) m1
55 integer ( kind = 4 ) m1d
56 integer ( kind = 4 ) m2
57 integer ( kind = 4 ) m2s
58 integer ( kind = 4 ) na
68 real ( kind = 4 ) wa(ido,3,2)
70 m1d = ( lot - 1 ) * im1 + 1
79 ti1 = cc(2,m1,k,1,1)-cc(2,m1,k,1,3)
80 ti2 = cc(2,m1,k,1,1)+cc(2,m1,k,1,3)
81 tr4 = cc(2,m1,k,1,2)-cc(2,m1,k,1,4)
82 ti3 = cc(2,m1,k,1,2)+cc(2,m1,k,1,4)
83 tr1 = cc(1,m1,k,1,1)-cc(1,m1,k,1,3)
84 tr2 = cc(1,m1,k,1,1)+cc(1,m1,k,1,3)
85 ti4 = cc(1,m1,k,1,4)-cc(1,m1,k,1,2)
86 tr3 = cc(1,m1,k,1,2)+cc(1,m1,k,1,4)
87 ch(1,m2,k,1,1) = tr2+tr3
88 ch(1,m2,k,3,1) = tr2-tr3
89 ch(2,m2,k,1,1) = ti2+ti3
90 ch(2,m2,k,3,1) = ti2-ti3
91 ch(1,m2,k,2,1) = tr1+tr4
92 ch(1,m2,k,4,1) = tr1-tr4
93 ch(2,m2,k,2,1) = ti1+ti4
94 ch(2,m2,k,4,1) = ti1-ti4
103 ti1 = cc(2,m1,k,i,1)-cc(2,m1,k,i,3)
104 ti2 = cc(2,m1,k,i,1)+cc(2,m1,k,i,3)
105 ti3 = cc(2,m1,k,i,2)+cc(2,m1,k,i,4)
106 tr4 = cc(2,m1,k,i,2)-cc(2,m1,k,i,4)
107 tr1 = cc(1,m1,k,i,1)-cc(1,m1,k,i,3)
108 tr2 = cc(1,m1,k,i,1)+cc(1,m1,k,i,3)
109 ti4 = cc(1,m1,k,i,4)-cc(1,m1,k,i,2)
110 tr3 = cc(1,m1,k,i,2)+cc(1,m1,k,i,4)
111 ch(1,m2,k,1,i) = tr2+tr3
113 ch(2,m2,k,1,i) = ti2+ti3
119 ch(1,m2,k,2,i) = wa(i,1,1)*cr2+wa(i,1,2)*ci2
120 ch(2,m2,k,2,i) = wa(i,1,1)*ci2-wa(i,1,2)*cr2
121 ch(1,m2,k,3,i) = wa(i,2,1)*cr3+wa(i,2,2)*ci3
122 ch(2,m2,k,3,i) = wa(i,2,1)*ci3-wa(i,2,2)*cr3
123 ch(1,m2,k,4,i) = wa(i,3,1)*cr4+wa(i,3,2)*ci4
124 ch(2,m2,k,4,i) = wa(i,3,1)*ci4-wa(i,3,2)*cr4
129 else if ( na == 1 ) then
131 sn = 1.0E+00 / real ( 4 * l1, kind = 4 )
137 ti1 = cc(2,m1,k,1,1)-cc(2,m1,k,1,3)
138 ti2 = cc(2,m1,k,1,1)+cc(2,m1,k,1,3)
139 tr4 = cc(2,m1,k,1,2)-cc(2,m1,k,1,4)
140 ti3 = cc(2,m1,k,1,2)+cc(2,m1,k,1,4)
141 tr1 = cc(1,m1,k,1,1)-cc(1,m1,k,1,3)
142 tr2 = cc(1,m1,k,1,1)+cc(1,m1,k,1,3)
143 ti4 = cc(1,m1,k,1,4)-cc(1,m1,k,1,2)
144 tr3 = cc(1,m1,k,1,2)+cc(1,m1,k,1,4)
145 ch(1,m2,k,1,1) = sn*(tr2+tr3)
146 ch(1,m2,k,3,1) = sn*(tr2-tr3)
147 ch(2,m2,k,1,1) = sn*(ti2+ti3)
148 ch(2,m2,k,3,1) = sn*(ti2-ti3)
149 ch(1,m2,k,2,1) = sn*(tr1+tr4)
150 ch(1,m2,k,4,1) = sn*(tr1-tr4)
151 ch(2,m2,k,2,1) = sn*(ti1+ti4)
152 ch(2,m2,k,4,1) = sn*(ti1-ti4)
158 sn = 1.0E+00 / real ( 4 * l1, kind = 4 )
162 ti1 = cc(2,m1,k,1,1)-cc(2,m1,k,1,3)
163 ti2 = cc(2,m1,k,1,1)+cc(2,m1,k,1,3)
164 tr4 = cc(2,m1,k,1,2)-cc(2,m1,k,1,4)
165 ti3 = cc(2,m1,k,1,2)+cc(2,m1,k,1,4)
166 tr1 = cc(1,m1,k,1,1)-cc(1,m1,k,1,3)
167 tr2 = cc(1,m1,k,1,1)+cc(1,m1,k,1,3)
168 ti4 = cc(1,m1,k,1,4)-cc(1,m1,k,1,2)
169 tr3 = cc(1,m1,k,1,2)+cc(1,m1,k,1,4)
170 cc(1,m1,k,1,1) = sn*(tr2+tr3)
171 cc(1,m1,k,1,3) = sn*(tr2-tr3)
172 cc(2,m1,k,1,1) = sn*(ti2+ti3)
173 cc(2,m1,k,1,3) = sn*(ti2-ti3)
174 cc(1,m1,k,1,2) = sn*(tr1+tr4)
175 cc(1,m1,k,1,4) = sn*(tr1-tr4)
176 cc(2,m1,k,1,2) = sn*(ti1+ti4)
177 cc(2,m1,k,1,4) = sn*(ti1-ti4)