105 SUBROUTINE ctrig(n, trig, after, before, now, isign, ic)
116 INTEGER :: after(7), before(7), now(7), isign, ic
118 CHARACTER(LEN=888) :: err
119 INTEGER :: i, itt, j, nh
120 INTEGER,
DIMENSION(7, 149) :: idata
121 REAL(kind=
dp) :: angle, trigc, trigs, twopi
124 DATA((idata(i, j), i=1, 7), j=1, 76)/ &
125 3, 3, 1, 1, 1, 1, 1, 4, 4, 1, 1, 1, 1, 1, &
126 5, 5, 1, 1, 1, 1, 1, 6, 6, 1, 1, 1, 1, 1, &
127 8, 8, 1, 1, 1, 1, 1, 9, 3, 3, 1, 1, 1, 1, &
128 12, 4, 3, 1, 1, 1, 1, 15, 5, 3, 1, 1, 1, 1, &
129 16, 4, 4, 1, 1, 1, 1, 18, 6, 3, 1, 1, 1, 1, &
130 20, 5, 4, 1, 1, 1, 1, 24, 8, 3, 1, 1, 1, 1, &
131 25, 5, 5, 1, 1, 1, 1, 27, 3, 3, 3, 1, 1, 1, &
132 30, 6, 5, 1, 1, 1, 1, 32, 8, 4, 1, 1, 1, 1, &
133 36, 4, 3, 3, 1, 1, 1, 40, 8, 5, 1, 1, 1, 1, &
134 45, 5, 3, 3, 1, 1, 1, 48, 4, 4, 3, 1, 1, 1, &
135 54, 6, 3, 3, 1, 1, 1, 60, 5, 4, 3, 1, 1, 1, &
136 64, 8, 8, 1, 1, 1, 1, 72, 8, 3, 3, 1, 1, 1, &
137 75, 5, 5, 3, 1, 1, 1, 80, 5, 4, 4, 1, 1, 1, &
138 81, 3, 3, 3, 3, 1, 1, 90, 6, 5, 3, 1, 1, 1, &
139 96, 8, 4, 3, 1, 1, 1, 100, 5, 5, 4, 1, 1, 1, &
140 108, 4, 3, 3, 3, 1, 1, 120, 8, 5, 3, 1, 1, 1, &
141 125, 5, 5, 5, 1, 1, 1, 128, 8, 4, 4, 1, 1, 1, &
142 135, 5, 3, 3, 3, 1, 1, 144, 6, 8, 3, 1, 1, 1, &
143 150, 6, 5, 5, 1, 1, 1, 160, 8, 5, 4, 1, 1, 1, &
144 162, 6, 3, 3, 3, 1, 1, 180, 5, 4, 3, 3, 1, 1, &
145 192, 6, 8, 4, 1, 1, 1, 200, 8, 5, 5, 1, 1, 1, &
146 216, 8, 3, 3, 3, 1, 1, 225, 5, 5, 3, 3, 1, 1, &
147 240, 6, 8, 5, 1, 1, 1, 243, 3, 3, 3, 3, 3, 1, &
148 256, 8, 8, 4, 1, 1, 1, 270, 6, 5, 3, 3, 1, 1, &
149 288, 8, 4, 3, 3, 1, 1, 300, 5, 5, 4, 3, 1, 1, &
150 320, 5, 4, 4, 4, 1, 1, 324, 4, 3, 3, 3, 3, 1, &
151 360, 8, 5, 3, 3, 1, 1, 375, 5, 5, 5, 3, 1, 1, &
152 384, 8, 4, 4, 3, 1, 1, 400, 5, 5, 4, 4, 1, 1, &
153 405, 5, 3, 3, 3, 3, 1, 432, 4, 4, 3, 3, 3, 1, &
154 450, 6, 5, 5, 3, 1, 1, 480, 8, 5, 4, 3, 1, 1, &
155 486, 6, 3, 3, 3, 3, 1, 500, 5, 5, 5, 4, 1, 1, &
156 512, 8, 8, 8, 1, 1, 1, 540, 5, 4, 3, 3, 3, 1, &
157 576, 4, 4, 4, 3, 3, 1, 600, 8, 5, 5, 3, 1, 1, &
158 625, 5, 5, 5, 5, 1, 1, 640, 8, 5, 4, 4, 1, 1, &
159 648, 8, 3, 3, 3, 3, 1, 675, 5, 5, 3, 3, 3, 1, &
160 720, 5, 4, 4, 3, 3, 1, 729, 3, 3, 3, 3, 3, 3, &
161 750, 6, 5, 5, 5, 1, 1, 768, 4, 4, 4, 4, 3, 1, &
162 800, 8, 5, 5, 4, 1, 1, 810, 6, 5, 3, 3, 3, 1/
163 DATA((idata(i, j), i=1, 7), j=77, 149)/ &
164 864, 8, 4, 3, 3, 3, 1, 900, 5, 5, 4, 3, 3, 1, &
165 960, 5, 4, 4, 4, 3, 1, 972, 4, 3, 3, 3, 3, 3, &
166 1000, 8, 5, 5, 5, 1, 1, 1024, 4, 4, 4, 4, 4, 1, &
167 1080, 6, 5, 4, 3, 3, 1, 1125, 5, 5, 5, 3, 3, 1, &
168 1152, 6, 4, 4, 4, 3, 1, 1200, 6, 8, 5, 5, 1, 1, &
169 1215, 5, 3, 3, 3, 3, 3, 1280, 8, 8, 5, 4, 1, 1, &
170 1296, 6, 8, 3, 3, 3, 1, 1350, 6, 5, 5, 3, 3, 1, &
171 1440, 6, 5, 4, 4, 3, 1, 1458, 6, 3, 3, 3, 3, 3, &
172 1500, 5, 5, 5, 4, 3, 1, 1536, 6, 8, 8, 4, 1, 1, &
173 1600, 8, 8, 5, 5, 1, 1, 1620, 5, 4, 3, 3, 3, 3, &
174 1728, 6, 8, 4, 3, 3, 1, 1800, 6, 5, 5, 4, 3, 1, &
175 1875, 5, 5, 5, 5, 3, 1, 1920, 6, 5, 4, 4, 4, 1, &
176 1944, 6, 4, 3, 3, 3, 3, 2000, 5, 5, 5, 4, 4, 1, &
177 2025, 5, 5, 3, 3, 3, 3, 2048, 8, 4, 4, 4, 4, 1, &
178 2160, 6, 8, 5, 3, 3, 1, 2250, 6, 5, 5, 5, 3, 1, &
179 2304, 6, 8, 4, 4, 3, 1, 2400, 6, 5, 5, 4, 4, 1, &
180 2430, 6, 5, 3, 3, 3, 3, 2500, 5, 5, 5, 5, 4, 1, &
181 2560, 8, 5, 4, 4, 4, 1, 2592, 6, 4, 4, 3, 3, 3, &
182 2700, 5, 5, 4, 3, 3, 3, 2880, 6, 8, 5, 4, 3, 1, &
183 3000, 6, 5, 5, 5, 4, 1, 3072, 6, 8, 4, 4, 4, 1, &
184 3125, 5, 5, 5, 5, 5, 1, 3200, 8, 5, 5, 4, 4, 1, &
185 3240, 6, 5, 4, 3, 3, 3, 3375, 5, 5, 5, 3, 3, 3, &
186 3456, 6, 4, 4, 4, 3, 3, 3600, 6, 8, 5, 5, 3, 1, &
187 3750, 6, 5, 5, 5, 5, 1, 3840, 6, 8, 5, 4, 4, 1, &
188 3888, 6, 8, 3, 3, 3, 3, 4000, 8, 5, 5, 5, 4, 1, &
189 4050, 6, 5, 5, 3, 3, 3, 4096, 8, 8, 4, 4, 4, 1, &
190 4320, 6, 5, 4, 4, 3, 3, 4500, 5, 5, 5, 4, 3, 3, &
191 4608, 6, 8, 8, 4, 3, 1, 4800, 6, 8, 5, 5, 4, 1, &
192 5000, 8, 5, 5, 5, 5, 1, 5120, 8, 8, 5, 4, 4, 1, &
193 5184, 6, 8, 4, 3, 3, 3, 5400, 6, 5, 5, 4, 3, 3, &
194 5625, 5, 5, 5, 5, 3, 3, 5760, 6, 8, 8, 5, 3, 1, &
195 6000, 6, 8, 5, 5, 5, 1, 6144, 6, 8, 8, 4, 4, 1, &
196 6400, 8, 8, 5, 5, 4, 1, 6480, 6, 8, 5, 3, 3, 3, &
197 6750, 6, 5, 5, 5, 3, 3, 6912, 6, 8, 4, 4, 3, 3, &
198 7200, 6, 5, 5, 4, 4, 3, 7500, 5, 5, 5, 5, 4, 3, &
199 7680, 6, 8, 8, 5, 4, 1, 8000, 8, 8, 5, 5, 5, 1, &
200 8192, 8, 8, 8, 4, 4, 1/
204 WRITE (err, *)
'VALUE OF', n,
'NOT ALLOWED FOR FFT, ALLOWED VALUES ARE:'
206 WRITE (err, 37) (idata(1, j), j=1, 149)
207 CALL cp_abort(__location__, trim(err))
209 IF (n == idata(1, i))
THEN
212 itt = idata(1 + j, i)
215 now(j) = idata(1 + j, i)
227 after(i) = after(i - 1)*now(i - 1)
228 before(ic - i + 1) = before(ic - i + 2)*now(ic - i + 2)
231 twopi = 6.283185307179586_dp
232 angle = isign*twopi/n
233 IF (mod(n, 2) == 0)
THEN
237 trig(1, nh + 1) = -1._dp
238 trig(2, nh + 1) = 0._dp
242 trig(1, i + 1) = trigc
243 trig(2, i + 1) = trigs
244 trig(1, n - i + 1) = trigc
245 trig(2, n - i + 1) = -trigs
254 trig(1, i + 1) = trigc
255 trig(2, i + 1) = trigs
256 trig(1, n - i + 1) = trigc
257 trig(2, n - i + 1) = -trigs
280 SUBROUTINE fftstp(mm, nfft, m, nn, n, zin, zout, trig, after, now, before, isign)
286 INTEGER :: mm, nfft, m, nn, n
287 REAL(kind=
dp) :: zin(2, mm, m), zout(2, nn, n), &
289 INTEGER :: after, now, before, isign
291 INTEGER :: atb, atn, ia, ias, ib, itrig, itt, j, &
292 nin1, nin2, nin3, nin4, nin5, nin6, &
293 nin7, nin8, nout1, nout2, nout3, &
294 nout4, nout5, nout6, nout7, nout8
295 REAL(kind=
dp) :: am, ap, bb, bm, bp, ci2, ci3, ci4, ci5, ci6, ci7, ci8, cm, cos2, cos4, cp, &
296 cr2, cr3, cr4, cr5, cr6, cr7, cr8, dm, dpp, r, r1, r2, r25, r3, r34, r4, r5, r6, r7, r8, &
297 rt2i, s, s1, s2, s25, s3, s34, s4, s5, s6, s7, s8, sin2, sin4, ui1, ui2, ui3, ur1, ur2, &
298 ur3, vi1, vi2, vi3, vr1, vr2, vr3
304 rt2i = 0.7071067811865475_dp
313 nout2 = nout1 + after
319 zout(1, j, nout1) = r2 + r1
320 zout(2, j, nout1) = s2 + s1
321 zout(1, j, nout2) = r1 - r2
322 zout(2, j, nout2) = s1 - s2
325 DO 2000, ia = 2, after
327 IF (2*ias == after)
THEN
335 nout2 = nout1 + after
341 zout(1, j, nout1) = r1 - r2
342 zout(2, j, nout1) = s2 + s1
343 zout(1, j, nout2) = r2 + r1
344 zout(2, j, nout2) = s1 - s2
354 nout2 = nout1 + after
360 zout(1, j, nout1) = r2 + r1
361 zout(2, j, nout1) = s1 - s2
362 zout(1, j, nout2) = r1 - r2
363 zout(2, j, nout2) = s2 + s1
367 ELSE IF (4*ias == after)
THEN
375 nout2 = nout1 + after
383 zout(1, j, nout1) = r2 + r1
384 zout(2, j, nout1) = s2 + s1
385 zout(1, j, nout2) = r1 - r2
386 zout(2, j, nout2) = s1 - s2
396 nout2 = nout1 + after
404 zout(1, j, nout1) = r2 + r1
405 zout(2, j, nout1) = s2 + s1
406 zout(1, j, nout2) = r1 - r2
407 zout(2, j, nout2) = s1 - s2
411 ELSE IF (4*ias == 3*after)
THEN
419 nout2 = nout1 + after
427 zout(1, j, nout1) = r1 - r2
428 zout(2, j, nout1) = s2 + s1
429 zout(1, j, nout2) = r2 + r1
430 zout(2, j, nout2) = s1 - s2
440 nout2 = nout1 + after
448 zout(1, j, nout1) = r2 + r1
449 zout(2, j, nout1) = s1 - s2
450 zout(1, j, nout2) = r1 - r2
451 zout(2, j, nout2) = s2 + s1
456 itrig = ias*before + 1
465 nout2 = nout1 + after
473 zout(1, j, nout1) = r2 + r1
474 zout(2, j, nout1) = s2 + s1
475 zout(1, j, nout2) = r1 - r2
476 zout(2, j, nout2) = s1 - s2
481 ELSE IF (now == 4)
THEN
492 nout2 = nout1 + after
493 nout3 = nout2 + after
494 nout4 = nout3 + after
506 zout(1, j, nout1) = r + s
507 zout(1, j, nout3) = r - s
510 zout(1, j, nout2) = r - s
511 zout(1, j, nout4) = r + s
514 zout(2, j, nout1) = r + s
515 zout(2, j, nout3) = r - s
518 zout(2, j, nout2) = r + s
519 zout(2, j, nout4) = r - s
522 DO 4000, ia = 2, after
524 IF (2*ias == after)
THEN
533 nout2 = nout1 + after
534 nout3 = nout2 + after
535 nout4 = nout3 + after
551 zout(1, j, nout1) = r + s
552 zout(1, j, nout3) = r - s
555 zout(1, j, nout2) = r - s
556 zout(1, j, nout4) = r + s
559 zout(2, j, nout1) = r + s
560 zout(2, j, nout3) = r - s
563 zout(2, j, nout2) = r + s
564 zout(2, j, nout4) = r - s
586 nout2 = nout1 + after
587 nout3 = nout2 + after
588 nout4 = nout3 + after
606 zout(1, j, nout1) = r + s
607 zout(1, j, nout3) = r - s
610 zout(1, j, nout2) = r - s
611 zout(1, j, nout4) = r + s
614 zout(2, j, nout1) = r + s
615 zout(2, j, nout3) = r - s
618 zout(2, j, nout2) = r + s
619 zout(2, j, nout4) = r - s
634 nout2 = nout1 + after
635 nout3 = nout2 + after
636 nout4 = nout3 + after
648 zout(1, j, nout1) = r + s
649 zout(1, j, nout3) = r - s
652 zout(1, j, nout2) = r + s
653 zout(1, j, nout4) = r - s
656 zout(2, j, nout1) = r + s
657 zout(2, j, nout3) = r - s
660 zout(2, j, nout2) = r - s
661 zout(2, j, nout4) = r + s
664 DO 4100, ia = 2, after
666 IF (2*ias == after)
THEN
675 nout2 = nout1 + after
676 nout3 = nout2 + after
677 nout4 = nout3 + after
693 zout(1, j, nout1) = r + s
694 zout(1, j, nout3) = r - s
697 zout(1, j, nout2) = r + s
698 zout(1, j, nout4) = r - s
701 zout(2, j, nout1) = r + s
702 zout(2, j, nout3) = r - s
705 zout(2, j, nout2) = r - s
706 zout(2, j, nout4) = r + s
728 nout2 = nout1 + after
729 nout3 = nout2 + after
730 nout4 = nout3 + after
748 zout(1, j, nout1) = r + s
749 zout(1, j, nout3) = r - s
752 zout(1, j, nout2) = r + s
753 zout(1, j, nout4) = r - s
756 zout(2, j, nout1) = r + s
757 zout(2, j, nout3) = r - s
760 zout(2, j, nout2) = r - s
761 zout(2, j, nout4) = r + s
767 ELSE IF (now == 8)
THEN
768 IF (isign == -1)
THEN
782 nout2 = nout1 + after
783 nout3 = nout2 + after
784 nout4 = nout3 + after
785 nout5 = nout4 + after
786 nout6 = nout5 + after
787 nout7 = nout6 + after
788 nout8 = nout7 + after
822 zout(1, j, nout1) = ap + bp
823 zout(2, j, nout1) = cp + dpp
824 zout(1, j, nout5) = ap - bp
825 zout(2, j, nout5) = cp - dpp
826 zout(1, j, nout3) = am + dm
827 zout(2, j, nout3) = cm - bm
828 zout(1, j, nout7) = am - dm
829 zout(2, j, nout7) = cm + bm
849 dpp = (cm - dpp)*rt2i
850 zout(1, j, nout2) = ap + r
851 zout(2, j, nout2) = bm + s
852 zout(1, j, nout6) = ap - r
853 zout(2, j, nout6) = bm - s
854 zout(1, j, nout4) = am + cp
855 zout(2, j, nout4) = bp + dpp
856 zout(1, j, nout8) = am - cp
857 zout(2, j, nout8) = bp - dpp
860 DO 8000, ia = 2, after
896 nout2 = nout1 + after
897 nout3 = nout2 + after
898 nout4 = nout3 + after
899 nout5 = nout4 + after
900 nout6 = nout5 + after
901 nout7 = nout6 + after
902 nout8 = nout7 + after
950 zout(1, j, nout1) = ap + bp
951 zout(2, j, nout1) = cp + dpp
952 zout(1, j, nout5) = ap - bp
953 zout(2, j, nout5) = cp - dpp
954 zout(1, j, nout3) = am + dm
955 zout(2, j, nout3) = cm - bm
956 zout(1, j, nout7) = am - dm
957 zout(2, j, nout7) = cm + bm
977 dpp = (cm - dpp)*rt2i
978 zout(1, j, nout2) = ap + r
979 zout(2, j, nout2) = bm + s
980 zout(1, j, nout6) = ap - r
981 zout(2, j, nout6) = bm - s
982 zout(1, j, nout4) = am + cp
983 zout(2, j, nout4) = bp + dpp
984 zout(1, j, nout8) = am - cp
985 zout(2, j, nout8) = bp - dpp
1004 nout2 = nout1 + after
1005 nout3 = nout2 + after
1006 nout4 = nout3 + after
1007 nout5 = nout4 + after
1008 nout6 = nout5 + after
1009 nout7 = nout6 + after
1010 nout8 = nout7 + after
1012 r1 = zin(1, j, nin1)
1013 s1 = zin(2, j, nin1)
1014 r2 = zin(1, j, nin2)
1015 s2 = zin(2, j, nin2)
1016 r3 = zin(1, j, nin3)
1017 s3 = zin(2, j, nin3)
1018 r4 = zin(1, j, nin4)
1019 s4 = zin(2, j, nin4)
1020 r5 = zin(1, j, nin5)
1021 s5 = zin(2, j, nin5)
1022 r6 = zin(1, j, nin6)
1023 s6 = zin(2, j, nin6)
1024 r7 = zin(1, j, nin7)
1025 s7 = zin(2, j, nin7)
1026 r8 = zin(1, j, nin8)
1027 s8 = zin(2, j, nin8)
1044 zout(1, j, nout1) = ap + bp
1045 zout(2, j, nout1) = cp + dpp
1046 zout(1, j, nout5) = ap - bp
1047 zout(2, j, nout5) = cp - dpp
1048 zout(1, j, nout3) = am - dm
1049 zout(2, j, nout3) = cm + bm
1050 zout(1, j, nout7) = am + dm
1051 zout(2, j, nout7) = cm - bm
1070 cp = (cm + dpp)*rt2i
1071 dpp = (dpp - cm)*rt2i
1072 zout(1, j, nout2) = ap + r
1073 zout(2, j, nout2) = bm + s
1074 zout(1, j, nout6) = ap - r
1075 zout(2, j, nout6) = bm - s
1076 zout(1, j, nout4) = am + cp
1077 zout(2, j, nout4) = bp + dpp
1078 zout(1, j, nout8) = am - cp
1079 zout(2, j, nout8) = bp - dpp
1083 DO 8001, ia = 2, after
1087 cr2 = trig(1, itrig)
1088 ci2 = trig(2, itrig)
1090 cr3 = trig(1, itrig)
1091 ci3 = trig(2, itrig)
1093 cr4 = trig(1, itrig)
1094 ci4 = trig(2, itrig)
1096 cr5 = trig(1, itrig)
1097 ci5 = trig(2, itrig)
1099 cr6 = trig(1, itrig)
1100 ci6 = trig(2, itrig)
1102 cr7 = trig(1, itrig)
1103 ci7 = trig(2, itrig)
1105 cr8 = trig(1, itrig)
1106 ci8 = trig(2, itrig)
1119 nout2 = nout1 + after
1120 nout3 = nout2 + after
1121 nout4 = nout3 + after
1122 nout5 = nout4 + after
1123 nout6 = nout5 + after
1124 nout7 = nout6 + after
1125 nout8 = nout7 + after
1127 r1 = zin(1, j, nin1)
1128 s1 = zin(2, j, nin1)
1173 zout(1, j, nout1) = ap + bp
1174 zout(2, j, nout1) = cp + dpp
1175 zout(1, j, nout5) = ap - bp
1176 zout(2, j, nout5) = cp - dpp
1177 zout(1, j, nout3) = am - dm
1178 zout(2, j, nout3) = cm + bm
1179 zout(1, j, nout7) = am + dm
1180 zout(2, j, nout7) = cm - bm
1199 cp = (cm + dpp)*rt2i
1200 dpp = (dpp - cm)*rt2i
1201 zout(1, j, nout2) = ap + r
1202 zout(2, j, nout2) = bm + s
1203 zout(1, j, nout6) = ap - r
1204 zout(2, j, nout6) = bm - s
1205 zout(1, j, nout4) = am + cp
1206 zout(2, j, nout4) = bp + dpp
1207 zout(1, j, nout8) = am - cp
1208 zout(2, j, nout8) = bp - dpp
1214 ELSE IF (now == 3)
THEN
1216 bb = isign*0.8660254037844387_dp
1225 nout2 = nout1 + after
1226 nout3 = nout2 + after
1228 r1 = zin(1, j, nin1)
1229 s1 = zin(2, j, nin1)
1230 r2 = zin(1, j, nin2)
1231 s2 = zin(2, j, nin2)
1232 r3 = zin(1, j, nin3)
1233 s3 = zin(2, j, nin3)
1236 zout(1, j, nout1) = r + r1
1237 zout(2, j, nout1) = s + s1
1242 zout(1, j, nout2) = r1 - s2
1243 zout(2, j, nout2) = s1 + r2
1244 zout(1, j, nout3) = r1 + s2
1245 zout(2, j, nout3) = s1 - r2
1248 DO 3000, ia = 2, after
1250 IF (4*ias == 3*after)
THEN
1251 IF (isign == 1)
THEN
1259 nout2 = nout1 + after
1260 nout3 = nout2 + after
1262 r1 = zin(1, j, nin1)
1263 s1 = zin(2, j, nin1)
1264 r2 = zin(2, j, nin2)
1265 s2 = zin(1, j, nin2)
1266 r3 = zin(1, j, nin3)
1267 s3 = zin(2, j, nin3)
1270 zout(1, j, nout1) = r1 - r
1271 zout(2, j, nout1) = s + s1
1276 zout(1, j, nout2) = r1 - s2
1277 zout(2, j, nout2) = s1 - r2
1278 zout(1, j, nout3) = r1 + s2
1279 zout(2, j, nout3) = s1 + r2
1290 nout2 = nout1 + after
1291 nout3 = nout2 + after
1293 r1 = zin(1, j, nin1)
1294 s1 = zin(2, j, nin1)
1295 r2 = zin(2, j, nin2)
1296 s2 = zin(1, j, nin2)
1297 r3 = zin(1, j, nin3)
1298 s3 = zin(2, j, nin3)
1301 zout(1, j, nout1) = r + r1
1302 zout(2, j, nout1) = s1 - s
1307 zout(1, j, nout2) = r1 + s2
1308 zout(2, j, nout2) = s1 + r2
1309 zout(1, j, nout3) = r1 - s2
1310 zout(2, j, nout3) = s1 - r2
1314 ELSE IF (8*ias == 3*after)
THEN
1315 IF (isign == 1)
THEN
1323 nout2 = nout1 + after
1324 nout3 = nout2 + after
1326 r1 = zin(1, j, nin1)
1327 s1 = zin(2, j, nin1)
1332 r3 = zin(2, j, nin3)
1333 s3 = zin(1, j, nin3)
1336 zout(1, j, nout1) = r + r1
1337 zout(2, j, nout1) = s + s1
1342 zout(1, j, nout2) = r1 - s2
1343 zout(2, j, nout2) = s1 + r2
1344 zout(1, j, nout3) = r1 + s2
1345 zout(2, j, nout3) = s1 - r2
1356 nout2 = nout1 + after
1357 nout3 = nout2 + after
1359 r1 = zin(1, j, nin1)
1360 s1 = zin(2, j, nin1)
1365 r3 = zin(2, j, nin3)
1366 s3 = zin(1, j, nin3)
1369 zout(1, j, nout1) = r + r1
1370 zout(2, j, nout1) = s + s1
1375 zout(1, j, nout2) = r1 - s2
1376 zout(2, j, nout2) = s1 + r2
1377 zout(1, j, nout3) = r1 + s2
1378 zout(2, j, nout3) = s1 - r2
1385 cr2 = trig(1, itrig)
1386 ci2 = trig(2, itrig)
1388 cr3 = trig(1, itrig)
1389 ci3 = trig(2, itrig)
1397 nout2 = nout1 + after
1398 nout3 = nout2 + after
1400 r1 = zin(1, j, nin1)
1401 s1 = zin(2, j, nin1)
1412 zout(1, j, nout1) = r + r1
1413 zout(2, j, nout1) = s + s1
1418 zout(1, j, nout2) = r1 - s2
1419 zout(2, j, nout2) = s1 + r2
1420 zout(1, j, nout3) = r1 + s2
1421 zout(2, j, nout3) = s1 - r2
1426 ELSE IF (now == 5)
THEN
1428 cos2 = 0.3090169943749474_dp
1430 cos4 = -0.8090169943749474_dp
1432 sin2 = isign*0.9510565162951536_dp
1434 sin4 = isign*0.5877852522924731_dp
1445 nout2 = nout1 + after
1446 nout3 = nout2 + after
1447 nout4 = nout3 + after
1448 nout5 = nout4 + after
1450 r1 = zin(1, j, nin1)
1451 s1 = zin(2, j, nin1)
1452 r2 = zin(1, j, nin2)
1453 s2 = zin(2, j, nin2)
1454 r3 = zin(1, j, nin3)
1455 s3 = zin(2, j, nin3)
1456 r4 = zin(1, j, nin4)
1457 s4 = zin(2, j, nin4)
1458 r5 = zin(1, j, nin5)
1459 s5 = zin(2, j, nin5)
1464 zout(1, j, nout1) = r1 + r25 + r34
1465 r = r1 + cos2*r25 + cos4*r34
1466 s = sin2*s25 + sin4*s34
1467 zout(1, j, nout2) = r - s
1468 zout(1, j, nout5) = r + s
1469 r = r1 + cos4*r25 + cos2*r34
1470 s = sin4*s25 - sin2*s34
1471 zout(1, j, nout3) = r - s
1472 zout(1, j, nout4) = r + s
1477 zout(2, j, nout1) = s1 + s25 + s34
1478 r = s1 + cos2*s25 + cos4*s34
1479 s = sin2*r25 + sin4*r34
1480 zout(2, j, nout2) = r + s
1481 zout(2, j, nout5) = r - s
1482 r = s1 + cos4*s25 + cos2*s34
1483 s = sin4*r25 - sin2*r34
1484 zout(2, j, nout3) = r + s
1485 zout(2, j, nout4) = r - s
1488 DO 5000, ia = 2, after
1490 IF (8*ias == 5*after)
THEN
1491 IF (isign == 1)
THEN
1501 nout2 = nout1 + after
1502 nout3 = nout2 + after
1503 nout4 = nout3 + after
1504 nout5 = nout4 + after
1506 r1 = zin(1, j, nin1)
1507 s1 = zin(2, j, nin1)
1512 r3 = zin(2, j, nin3)
1513 s3 = zin(1, j, nin3)
1518 r5 = zin(1, j, nin5)
1519 s5 = zin(2, j, nin5)
1524 zout(1, j, nout1) = r1 + r25 - r34
1525 r = r1 + cos2*r25 - cos4*r34
1526 s = sin2*s25 + sin4*s34
1527 zout(1, j, nout2) = r - s
1528 zout(1, j, nout5) = r + s
1529 r = r1 + cos4*r25 - cos2*r34
1530 s = sin4*s25 - sin2*s34
1531 zout(1, j, nout3) = r - s
1532 zout(1, j, nout4) = r + s
1537 zout(2, j, nout1) = s1 + s25 + s34
1538 r = s1 + cos2*s25 + cos4*s34
1539 s = sin2*r25 + sin4*r34
1540 zout(2, j, nout2) = r + s
1541 zout(2, j, nout5) = r - s
1542 r = s1 + cos4*s25 + cos2*s34
1543 s = sin4*r25 - sin2*r34
1544 zout(2, j, nout3) = r + s
1545 zout(2, j, nout4) = r - s
1558 nout2 = nout1 + after
1559 nout3 = nout2 + after
1560 nout4 = nout3 + after
1561 nout5 = nout4 + after
1563 r1 = zin(1, j, nin1)
1564 s1 = zin(2, j, nin1)
1569 r3 = zin(2, j, nin3)
1570 s3 = zin(1, j, nin3)
1575 r5 = zin(1, j, nin5)
1576 s5 = zin(2, j, nin5)
1581 zout(1, j, nout1) = r1 + r25 + r34
1582 r = r1 + cos2*r25 + cos4*r34
1583 s = sin2*s25 + sin4*s34
1584 zout(1, j, nout2) = r - s
1585 zout(1, j, nout5) = r + s
1586 r = r1 + cos4*r25 + cos2*r34
1587 s = sin4*s25 - sin2*s34
1588 zout(1, j, nout3) = r - s
1589 zout(1, j, nout4) = r + s
1594 zout(2, j, nout1) = s1 + s25 - s34
1595 r = s1 + cos2*s25 - cos4*s34
1596 s = sin2*r25 + sin4*r34
1597 zout(2, j, nout2) = r + s
1598 zout(2, j, nout5) = r - s
1599 r = s1 + cos4*s25 - cos2*s34
1600 s = sin4*r25 - sin2*r34
1601 zout(2, j, nout3) = r + s
1602 zout(2, j, nout4) = r - s
1610 cr2 = trig(1, itrig)
1611 ci2 = trig(2, itrig)
1613 cr3 = trig(1, itrig)
1614 ci3 = trig(2, itrig)
1616 cr4 = trig(1, itrig)
1617 ci4 = trig(2, itrig)
1619 cr5 = trig(1, itrig)
1620 ci5 = trig(2, itrig)
1630 nout2 = nout1 + after
1631 nout3 = nout2 + after
1632 nout4 = nout3 + after
1633 nout5 = nout4 + after
1635 r1 = zin(1, j, nin1)
1636 s1 = zin(2, j, nin1)
1657 zout(1, j, nout1) = r1 + r25 + r34
1658 r = r1 + cos2*r25 + cos4*r34
1659 s = sin2*s25 + sin4*s34
1660 zout(1, j, nout2) = r - s
1661 zout(1, j, nout5) = r + s
1662 r = r1 + cos4*r25 + cos2*r34
1663 s = sin4*s25 - sin2*s34
1664 zout(1, j, nout3) = r - s
1665 zout(1, j, nout4) = r + s
1670 zout(2, j, nout1) = s1 + s25 + s34
1671 r = s1 + cos2*s25 + cos4*s34
1672 s = sin2*r25 + sin4*r34
1673 zout(2, j, nout2) = r + s
1674 zout(2, j, nout5) = r - s
1675 r = s1 + cos4*s25 + cos2*s34
1676 s = sin4*r25 - sin2*r34
1677 zout(2, j, nout3) = r + s
1678 zout(2, j, nout4) = r - s
1683 ELSE IF (now == 6)
THEN
1685 bb = isign*0.8660254037844387_dp
1698 nout2 = nout1 + after
1699 nout3 = nout2 + after
1700 nout4 = nout3 + after
1701 nout5 = nout4 + after
1702 nout6 = nout5 + after
1704 r2 = zin(1, j, nin3)
1705 s2 = zin(2, j, nin3)
1706 r3 = zin(1, j, nin5)
1707 s3 = zin(2, j, nin5)
1710 r1 = zin(1, j, nin1)
1711 s1 = zin(2, j, nin1)
1723 r2 = zin(1, j, nin6)
1724 s2 = zin(2, j, nin6)
1725 r3 = zin(1, j, nin2)
1726 s3 = zin(2, j, nin2)
1729 r1 = zin(1, j, nin4)
1730 s1 = zin(2, j, nin4)
1742 zout(1, j, nout1) = ur1 + vr1
1743 zout(2, j, nout1) = ui1 + vi1
1744 zout(1, j, nout5) = ur2 + vr2
1745 zout(2, j, nout5) = ui2 + vi2
1746 zout(1, j, nout3) = ur3 + vr3
1747 zout(2, j, nout3) = ui3 + vi3
1748 zout(1, j, nout4) = ur1 - vr1
1749 zout(2, j, nout4) = ui1 - vi1
1750 zout(1, j, nout2) = ur2 - vr2
1751 zout(2, j, nout2) = ui2 - vi2
1752 zout(1, j, nout6) = ur3 - vr3
1753 zout(2, j, nout6) = ui3 - vi3
1757 cpabort(
"error fftstp")