MPI-AMRVAC 3.2
The MPI - Adaptive Mesh Refinement - Versatile Advection Code (development version)
Loading...
Searching...
No Matches
mod_fft.t
Go to the documentation of this file.
1!> Self-contained complex FFT utilities based on the mixed-radix Singleton
2!> transform historically embedded in mod_pfss.
3module mod_fft
4 use mod_comm_lib, only: mpistop
5 implicit none
6
7 private
8
9 public :: fft_1d
10 public :: fft_2d
11 public :: fft_2d_real_imag
12 public :: fft_raw
13 public :: fft_size_supported
14 public :: fft_next_supported
15 public :: fft_factorization
16
17contains
18
19 !> Return whether the legacy mixed-radix workspace can handle a transform.
20 logical function fft_size_supported(n)
21 integer, intent(in) :: n
22 integer :: m,p,nleft,nfactors,square_free
23
24 if(n<1) then
25 fft_size_supported=.false.
26 return
27 end if
28
29 nleft=n
30 nfactors=0
31 square_free=1
32 p=2
33 do while(p*p<=nleft)
34 if(mod(nleft,p)==0) then
35 if(p>23) then
36 fft_size_supported=.false.
37 return
38 end if
39 square_free=square_free*p
40 do while(mod(nleft,p)==0)
41 nleft=nleft/p
42 nfactors=nfactors+1
43 end do
44 end if
45 if(p==2) then
46 p=3
47 else
48 p=p+2
49 end if
50 end do
51 if(nleft>1) then
52 if(nleft>23) then
53 fft_size_supported=.false.
54 return
55 end if
56 square_free=square_free*nleft
57 nfactors=nfactors+1
58 end if
59
60 ! The embedded algorithm stores at most 11 factors and 209 permutation
61 ! entries. Repeated powers of two are combined internally, so this check is
62 ! deliberately conservative only for the general prime-factor path.
63 m=n
64 nfactors=0
65 do p=2,23
66 do while(mod(m,p)==0)
67 m=m/p
68 nfactors=nfactors+1
69 end do
70 end do
71 fft_size_supported=(m==1 .and. nfactors<=11 .and. square_free<=210)
72 end function fft_size_supported
73
74 integer function fft_next_supported(n)
75 integer, intent(in) :: n
76
77 fft_next_supported=max(1,n)
80 end do
81 end function fft_next_supported
82
83 !> Human-readable prime factorization used in unsupported-size diagnostics.
84 function fft_factorization(n) result(description)
85 integer, intent(in) :: n
86 character(len=128) :: description
87 character(len=24) :: item
88 integer :: left,p,power,used
89
90 description=''
91 if(n<1) then
92 write(description,'(i0)') n
93 return
94 end if
95
96 left=n
97 p=2
98 used=0
99 do while(p*p<=left)
100 power=0
101 do while(mod(left,p)==0)
102 left=left/p
103 power=power+1
104 end do
105 if(power>0) then
106 if(power==1) then
107 write(item,'(i0)') p
108 else
109 write(item,'(i0,a,i0)') p,'^',power
110 end if
111 if(used>0) description=trim(description)//' * '
112 description=trim(description)//trim(item)
113 used=used+1
114 end if
115 if(p==2) then
116 p=3
117 else
118 p=p+2
119 end if
120 end do
121 if(left>1) then
122 write(item,'(i0)') left
123 if(used>0) description=trim(description)//' * '
124 description=trim(description)//trim(item)
125 end if
126 if(len_trim(description)==0) description='1'
127 end function fft_factorization
128
129 !> In-place complex one-dimensional FFT. The inverse is normalized.
130 subroutine fft_1d(data,inverse)
131 double complex, intent(inout) :: data(:)
132 logical, intent(in) :: inverse
133 double precision, allocatable :: ar(:),ai(:)
134 integer :: n,isign
135
136 n=size(data)
137 if(.not.fft_size_supported(n)) error stop 'fft_1d: unsupported transform size'
138 allocate(ar(n),ai(n))
139 ar=dble(data)
140 ai=dimag(data)
141 if(inverse) then
142 isign=1
143 else
144 isign=-1
145 end if
146 call fft_raw(ar,ai,n,n,n,isign)
147 data=dcmplx(ar,ai)
148 if(inverse) data=data/dble(n)
149 deallocate(ar,ai)
150 end subroutine fft_1d
151
152 !> In-place complex two-dimensional FFT. The inverse is normalized.
153 subroutine fft_2d(data,inverse)
154 double complex, intent(inout) :: data(:,:)
155 logical, intent(in) :: inverse
156 double precision, allocatable :: ar(:),ai(:)
157 integer :: n1,n2,ntot,isign
158
159 n1=size(data,1)
160 n2=size(data,2)
161 if(.not.fft_size_supported(n1) .or. .not.fft_size_supported(n2)) &
162 error stop 'fft_2d: unsupported transform size'
163
164 ntot=n1*n2
165 allocate(ar(ntot),ai(ntot))
166 ar=reshape(dble(data),[ntot])
167 ai=reshape(dimag(data),[ntot])
168 if(inverse) then
169 isign=1
170 else
171 isign=-1
172 end if
173 call fft_raw(ar,ai,ntot,n1,n1,isign)
174 call fft_raw(ar,ai,ntot,n2,ntot,isign)
175 data=reshape(dcmplx(ar,ai),shape(data))
176 if(inverse) data=data/dble(ntot)
177 deallocate(ar,ai)
178 end subroutine fft_2d
179
180 !> In-place two-dimensional FFT on split real/imaginary storage. This avoids
181 !> allocation and copying in repeated plane transforms.
182 subroutine fft_2d_real_imag(ar,ai,inverse)
183 double precision, intent(inout) :: ar(:,:),ai(:,:)
184 logical, intent(in) :: inverse
185 integer :: n1,n2,ntot,isign
186
187 n1=size(ar,1)
188 n2=size(ar,2)
189 if(any(shape(ai)/=shape(ar))) error stop 'fft_2d_real_imag: shape mismatch'
190 if(.not.fft_size_supported(n1) .or. .not.fft_size_supported(n2)) &
191 error stop 'fft_2d_real_imag: unsupported transform size'
192
193 ntot=n1*n2
194 if(inverse) then
195 isign=1
196 else
197 isign=-1
198 end if
199 call fft_raw(ar,ai,ntot,n1,n1,isign)
200 call fft_raw(ar,ai,ntot,n2,ntot,isign)
201 if(inverse) then
202 ar=ar/dble(ntot)
203 ai=ai/dble(ntot)
204 end if
205 end subroutine fft_2d_real_imag
206
207 subroutine fft_raw(a,b,ntot,n,nspan,isn)
208 ! multivariate complex fourier transform, computed in place
209 ! using mixed-radix fast fourier transform algorithm.
210 ! by r. c. singleton, stanford research institute, sept. 1968
211 ! arrays a and b originally hold the real and imaginary
212 ! components of the data, and return the real and
213 ! imaginary components of the resulting fourier coefficients.
214 ! multivariate data is indexed according to the fortran
215 ! array element successor function, without limit
216 ! on the number of implied multiple subscripts.
217 ! the subroutine is called once for each variate.
218 ! the calls for a multivariate transform may be in any order.
219 ! ntot is the total number of complex data values.
220 ! n is the dimension of the current variable.
221 ! nspan/n is the spacing of consecutive data values
222 ! while indexing the current variable.
223 ! the sign of isn determines the sign of the complex
224 ! exponential, and the magnitude of isn is normally one.
225 ! a tri-variate transform with a(n1,n2,n3), b(n1,n2,n3)
226 ! is computed by
227 ! call fft(a,b,n1*n2*n3,n1,n1,1)
228 ! call fft(a,b,n1*n2*n3,n2,n1*n2,1)
229 ! call fft(a,b,n1*n2*n3,n3,n1*n2*n3,1)
230 ! for a single-variate transform,
231 ! ntot = n = nspan = (number of complex data values), e.g.
232 ! call fft(a,b,n,n,n,1)
233 ! the data can alternatively be stored in a single complex array c
234 ! in standard fortran fashion, i.e. alternating real and imaginary
235 ! parts. then with most fortran compilers, the complex array c can
236 ! be equivalenced to a real array a, the magnitude of isn changed
237 ! to two to give correct indexing increment, and a(1) and a(2) used
238 ! to pass the initial addresses for the sequences of real and
239 ! imaginary values, e.g.
240 ! complex c(ntot)
241 ! real a(2*ntot)
242 ! equivalence (c(1),a(1))
243 ! call fft(a(1),a(2),ntot,n,nspan,2)
244 ! arrays at(maxf), ck(maxf), bt(maxf), sk(maxf), and np(maxp)
245 ! are used for temporary storage. if the available storage
246 ! is insufficient, the program is terminated by a stop.
247 ! maxf must be .ge. the maximum prime factor of n.
248 ! maxp must be .gt. the number of prime factors of n.
249 ! in addition, if the square-free portion k of n has two or
250 ! more prime factors, then maxp must be .ge. k-1.
251 double precision :: a(*),b(*)
252 ! array storage in nfac for a maximum of 15 prime factors of n.
253 ! if n has more than one square-free factor, the product of the
254 ! square-free factors must be .le. 210
255 dimension nfac(11),np(209)
256 ! array storage for maximum prime factor of 23
257 dimension at(23),ck(23),bt(23),sk(23)
258 double precision :: c72,s72,s120,rad,radf,sd,cd,ak,bk,c1
259 double precision :: s1,aj,bj,akp,ajp,ajm,akm,bkp,bkm,bjp,bjm,aa
260 double precision :: bb,sk,ck,at,bt,s3,c3,s2,c2
261 integer :: i,ii,maxp,maxf,n,inc,isn,nt,ntot,ks,nspan,kspan,nn,jc,jf,m
262 integer :: k,j,jj,nfac,kt,np,kk,k1,k2,k3,k4,kspnn
263 equivalence(i,ii)
264
265 ! the following two constants should agree with the array dimensions.
266 maxp=209
267 ! Date: Wed, 9 Aug 1995 09:38:49 -0400
268 ! From: ldm@apollo.numis.nwu.edu
269 maxf=23
270 s3=0.d0
271 s2=0.d0
272 c3=0.d0
273 c2=0.d0
274 if(n .lt. 2) return
275 inc=isn
276 c72=0.30901699437494742d0
277 s72=0.95105651629515357d0
278 s120=0.86602540378443865d0
279 rad=6.2831853071796d0
280 if(isn .ge. 0) go to 10
281 s72=-s72
282 s120=-s120
283 rad=-rad
284 inc=-inc
285 10 nt=inc*ntot
286 ks=inc*nspan
287 kspan=ks
288 nn=nt-inc
289 jc=ks/n
290 radf=rad*dble(jc)*0.5d0
291 i=0
292 jf=0
293 ! determine the factors of n
294 m=0
295 k=n
296 go to 20
297 15 m=m+1
298 nfac(m)=4
299 k=k/16
300 20 if(k-(k/16)*16 .eq. 0) go to 15
301 j=3
302 jj=9
303 go to 30
304 25 m=m+1
305 nfac(m)=j
306 k=k/jj
307 30 if(mod(k,jj) .eq. 0) go to 25
308 j=j+2
309 jj=j**2
310 if(jj .le. k) go to 30
311 if(k .gt. 4) go to 40
312 kt=m
313 nfac(m+1)=k
314 if(k .ne. 1) m=m+1
315 go to 80
316 40 if(k-(k/4)*4 .ne. 0) go to 50
317 m=m+1
318 nfac(m)=2
319 k=k/4
320 50 kt=m
321 j=2
322 60 if(mod(k,j) .ne. 0) go to 70
323 m=m+1
324 nfac(m)=j
325 k=k/j
326 70 j=((j+1)/2)*2+1
327 if(j .le. k) go to 60
328 80 if(kt .eq. 0) go to 100
329 j=kt
330 90 m=m+1
331 nfac(m)=nfac(j)
332 j=j-1
333 if(j .ne. 0) go to 90
334 ! compute fourier transform
335 100 sd=radf/dble(kspan)
336 cd=2.d0*dsin(sd)**2
337 sd=dsin(sd+sd)
338 kk=1
339 i=i+1
340 if(nfac(i) .ne. 2) go to 400
341 ! transform for factor of 2 (including rotation factor)
342 kspan=kspan/2
343 k1=kspan+2
344 210 k2=kk+kspan
345 ak=a(k2)
346 bk=b(k2)
347 a(k2)=a(kk)-ak
348 b(k2)=b(kk)-bk
349 a(kk)=a(kk)+ak
350 b(kk)=b(kk)+bk
351 kk=k2+kspan
352 if(kk .le. nn) go to 210
353 kk=kk-nn
354 if(kk .le. jc) go to 210
355 if(kk .gt. kspan) go to 800
356 220 c1=1.d0-cd
357 s1=sd
358 230 k2=kk+kspan
359 ak=a(kk)-a(k2)
360 bk=b(kk)-b(k2)
361 a(kk)=a(kk)+a(k2)
362 b(kk)=b(kk)+b(k2)
363 a(k2)=c1*ak-s1*bk
364 b(k2)=s1*ak+c1*bk
365 kk=k2+kspan
366 if(kk .lt. nt) go to 230
367 k2=kk-nt
368 c1=-c1
369 kk=k1-k2
370 if(kk .gt. k2) go to 230
371 ak=c1-(cd*c1+sd*s1)
372 s1=(sd*c1-cd*s1)+s1
373 c1=2.d0-(ak**2+s1**2)
374 s1=c1*s1
375 c1=c1*ak
376 kk=kk+jc
377 if(kk .lt. k2) go to 230
378 k1=k1+inc+inc
379 kk=(k1-kspan)/2+jc
380 if(kk .le. jc+jc) go to 220
381 go to 100
382 ! transform for factor of 3 (optional code)
383 320 k1=kk+kspan
384 k2=k1+kspan
385 ak=a(kk)
386 bk=b(kk)
387 aj=a(k1)+a(k2)
388 bj=b(k1)+b(k2)
389 a(kk)=ak+aj
390 b(kk)=bk+bj
391 ak=-0.5d0*aj+ak
392 bk=-0.5d0*bj+bk
393 aj=(a(k1)-a(k2))*s120
394 bj=(b(k1)-b(k2))*s120
395 a(k1)=ak-bj
396 b(k1)=bk+aj
397 a(k2)=ak+bj
398 b(k2)=bk-aj
399 kk=k2+kspan
400 if(kk .lt. nn) go to 320
401 kk=kk-nn
402 if(kk .le. kspan) go to 320
403 go to 700
404 ! transform for factor of 4
405 400 if(nfac(i) .ne. 4) go to 600
406 kspnn=kspan
407 kspan=kspan/4
408 410 c1=1.d0
409 s1=0.d0
410 420 k1=kk+kspan
411 k2=k1+kspan
412 k3=k2+kspan
413 akp=a(kk)+a(k2)
414 akm=a(kk)-a(k2)
415 ajp=a(k1)+a(k3)
416 ajm=a(k1)-a(k3)
417 a(kk)=akp+ajp
418 ajp=akp-ajp
419 bkp=b(kk)+b(k2)
420 bkm=b(kk)-b(k2)
421 bjp=b(k1)+b(k3)
422 bjm=b(k1)-b(k3)
423 b(kk)=bkp+bjp
424 bjp=bkp-bjp
425 if(isn .lt. 0) go to 450
426 akp=akm-bjm
427 akm=akm+bjm
428 bkp=bkm+ajm
429 bkm=bkm-ajm
430 if(s1 .eq. 0.d0) go to 460
431 430 a(k1)=akp*c1-bkp*s1
432 b(k1)=akp*s1+bkp*c1
433 a(k2)=ajp*c2-bjp*s2
434 b(k2)=ajp*s2+bjp*c2
435 a(k3)=akm*c3-bkm*s3
436 b(k3)=akm*s3+bkm*c3
437 kk=k3+kspan
438 if(kk .le. nt) go to 420
439 440 c2=c1-(cd*c1+sd*s1)
440 s1=(sd*c1-cd*s1)+s1
441 c1=2.d0-(c2**2+s1**2)
442 s1=c1*s1
443 c1=c1*c2
444 c2=c1**2-s1**2
445 s2=2.d0*c1*s1
446 c3=c2*c1-s2*s1
447 s3=c2*s1+s2*c1
448 kk=kk-nt+jc
449 if(kk .le. kspan) go to 420
450 kk=kk-kspan+inc
451 if(kk .le. jc) go to 410
452 if(kspan .eq. jc) go to 800
453 go to 100
454 450 akp=akm+bjm
455 akm=akm-bjm
456 bkp=bkm-ajm
457 bkm=bkm+ajm
458 if(s1 .ne. 0) go to 430
459 460 a(k1)=akp
460 b(k1)=bkp
461 a(k2)=ajp
462 b(k2)=bjp
463 a(k3)=akm
464 b(k3)=bkm
465 kk=k3+kspan
466 if(kk .le. nt) go to 420
467 go to 440
468 ! transform for factor of 5 (optional code)
469 510 c2=c72**2-s72**2
470 s2=2.d0*c72*s72
471 520 k1=kk+kspan
472 k2=k1+kspan
473 k3=k2+kspan
474 k4=k3+kspan
475 akp=a(k1)+a(k4)
476 akm=a(k1)-a(k4)
477 bkp=b(k1)+b(k4)
478 bkm=b(k1)-b(k4)
479 ajp=a(k2)+a(k3)
480 ajm=a(k2)-a(k3)
481 bjp=b(k2)+b(k3)
482 bjm=b(k2)-b(k3)
483 aa=a(kk)
484 bb=b(kk)
485 a(kk)=aa+akp+ajp
486 b(kk)=bb+bkp+bjp
487 ak=akp*c72+ajp*c2+aa
488 bk=bkp*c72+bjp*c2+bb
489 aj=akm*s72+ajm*s2
490 bj=bkm*s72+bjm*s2
491 a(k1)=ak-bj
492 a(k4)=ak+bj
493 b(k1)=bk+aj
494 b(k4)=bk-aj
495 ak=akp*c2+ajp*c72+aa
496 bk=bkp*c2+bjp*c72+bb
497 aj=akm*s2-ajm*s72
498 bj=bkm*s2-bjm*s72
499 a(k2)=ak-bj
500 a(k3)=ak+bj
501 b(k2)=bk+aj
502 b(k3)=bk-aj
503 kk=k4+kspan
504 if(kk .lt. nn) go to 520
505 kk=kk-nn
506 if(kk .le. kspan) go to 520
507 go to 700
508 ! transform for odd factors
509 600 k=nfac(i)
510 kspnn=kspan
511 kspan=kspan/k
512 if(k .eq. 3) go to 320
513 if(k .eq. 5) go to 510
514 if(k .eq. jf) go to 640
515 jf=k
516 s1=rad/dble(k)
517 c1=dcos(s1)
518 s1=dsin(s1)
519 if(jf .gt. maxf) go to 998
520 ck(jf)=1.d0
521 sk(jf)=0.d0
522 j=1
523 630 ck(j)=ck(k)*c1+sk(k)*s1
524 sk(j)=ck(k)*s1-sk(k)*c1
525 k=k-1
526 ck(k)=ck(j)
527 sk(k)=-sk(j)
528 j=j+1
529 if(j .lt. k) go to 630
530 640 k1=kk
531 k2=kk+kspnn
532 aa=a(kk)
533 bb=b(kk)
534 ak=aa
535 bk=bb
536 j=1
537 k1=k1+kspan
538 650 k2=k2-kspan
539 j=j+1
540 at(j)=a(k1)+a(k2)
541 ak=at(j)+ak
542 bt(j)=b(k1)+b(k2)
543 bk=bt(j)+bk
544 j=j+1
545 at(j)=a(k1)-a(k2)
546 bt(j)=b(k1)-b(k2)
547 k1=k1+kspan
548 if(k1 .lt. k2) go to 650
549 a(kk)=ak
550 b(kk)=bk
551 k1=kk
552 k2=kk+kspnn
553 j=1
554 660 k1=k1+kspan
555 k2=k2-kspan
556 jj=j
557 ak=aa
558 bk=bb
559 aj=0.d0
560 bj=0.d0
561 k=1
562 670 k=k+1
563 ak=at(k)*ck(jj)+ak
564 bk=bt(k)*ck(jj)+bk
565 k=k+1
566 aj=at(k)*sk(jj)+aj
567 bj=bt(k)*sk(jj)+bj
568 jj=jj+j
569 if(jj .gt. jf) jj=jj-jf
570 if(k .lt. jf) go to 670
571 k=jf-j
572 a(k1)=ak-bj
573 b(k1)=bk+aj
574 a(k2)=ak+bj
575 b(k2)=bk-aj
576 j=j+1
577 if(j .lt. k) go to 660
578 kk=kk+kspnn
579 if(kk .le. nn) go to 640
580 kk=kk-nn
581 if(kk .le. kspan) go to 640
582 ! multiply by rotation factor (except for factors of 2 and 4)
583 700 if(i .eq. m) go to 800
584 kk=jc+1
585 710 c2=1.d0-cd
586 s1=sd
587 720 c1=c2
588 s2=s1
589 kk=kk+kspan
590 730 ak=a(kk)
591 a(kk)=c2*ak-s2*b(kk)
592 b(kk)=s2*ak+c2*b(kk)
593 kk=kk+kspnn
594 if(kk .le. nt) go to 730
595 ak=s1*s2
596 s2=s1*c2+c1*s2
597 c2=c1*c2-ak
598 kk=kk-nt+kspan
599 if(kk .le. kspnn) go to 730
600 c2=c1-(cd*c1+sd*s1)
601 s1=s1+(sd*c1-cd*s1)
602 c1=2.d0-(c2**2+s1**2)
603 s1=c1*s1
604 c2=c1*c2
605 kk=kk-kspnn+jc
606 if(kk .le. kspan) go to 720
607 kk=kk-kspan+jc+inc
608 if(kk .le. jc+jc) go to 710
609 go to 100
610 ! permute the results to normal order---done in two stages
611 ! permutation for square factors of n
612 800 np(1)=ks
613 if(kt .eq. 0) go to 890
614 k=kt+kt+1
615 if(m .lt. k) k=k-1
616 j=1
617 np(k+1)=jc
618 810 np(j+1)=np(j)/nfac(j)
619 np(k)=np(k+1)*nfac(j)
620 j=j+1
621 k=k-1
622 if(j .lt. k) go to 810
623 k3=np(k+1)
624 kspan=np(2)
625 kk=jc+1
626 k2=kspan+1
627 j=1
628 if(n .ne. ntot) go to 850
629 ! permutation for single-variate transform (optional code)
630 820 ak=a(kk)
631 a(kk)=a(k2)
632 a(k2)=ak
633 bk=b(kk)
634 b(kk)=b(k2)
635 b(k2)=bk
636 kk=kk+inc
637 k2=kspan+k2
638 if(k2 .lt. ks) go to 820
639 830 k2=k2-np(j)
640 j=j+1
641 k2=np(j+1)+k2
642 if(k2 .gt. np(j)) go to 830
643 j=1
644 840 if(kk .lt. k2) go to 820
645 kk=kk+inc
646 k2=kspan+k2
647 if(k2 .lt. ks) go to 840
648 if(kk .lt. ks) go to 830
649 jc=k3
650 go to 890
651 ! permutation for multivariate transform
652 850 k=kk+jc
653 860 ak=a(kk)
654 a(kk)=a(k2)
655 a(k2)=ak
656 bk=b(kk)
657 b(kk)=b(k2)
658 b(k2)=bk
659 kk=kk+inc
660 k2=k2+inc
661 if(kk .lt. k) go to 860
662 kk=kk+ks-jc
663 k2=k2+ks-jc
664 if(kk .lt. nt) go to 850
665 k2=k2-nt+kspan
666 kk=kk-nt+jc
667 if(k2 .lt. ks) go to 850
668 870 k2=k2-np(j)
669 j=j+1
670 k2=np(j+1)+k2
671 if(k2 .gt. np(j)) go to 870
672 j=1
673 880 if(kk .lt. k2) go to 850
674 kk=kk+jc
675 k2=kspan+k2
676 if(k2 .lt. ks) go to 880
677 if(kk .lt. ks) go to 870
678 jc=k3
679 890 if(2*kt+1 .ge. m) return
680 kspnn=np(kt+1)
681 ! permutation for square-free factors of n
682 j=m-kt
683 nfac(j+1)=1
684 900 nfac(j)=nfac(j)*nfac(j+1)
685 j=j-1
686 if(j .ne. kt) go to 900
687 kt=kt+1
688 nn=nfac(kt)-1
689 if(nn .gt. maxp) go to 998
690 jj=0
691 j=0
692 go to 906
693 902 jj=jj-k2
694 k2=kk
695 k=k+1
696 kk=nfac(k)
697 904 jj=kk+jj
698 if(jj .ge. k2) go to 902
699 np(j)=jj
700 906 k2=nfac(kt)
701 k=kt+1
702 kk=nfac(k)
703 j=j+1
704 if(j .le. nn) go to 904
705 ! determine the permutation cycles of length greater than 1
706 j=0
707 go to 914
708 910 k=kk
709 kk=np(k)
710 np(k)=-kk
711 if(kk .ne. j) go to 910
712 k3=kk
713 914 j=j+1
714 kk=np(j)
715 if(kk .lt. 0) go to 914
716 if(kk .ne. j) go to 910
717 np(j)=-j
718 if(j .ne. nn) go to 914
719 maxf=inc*maxf
720 ! reorder a and b, following the permutation cycles
721 go to 950
722 924 j=j-1
723 if(np(j) .lt. 0) go to 924
724 jj=jc
725 926 kspan=jj
726 if(jj .gt. maxf) kspan=maxf
727 jj=jj-kspan
728 k=np(j)
729 kk=jc*k+ii+jj
730 k1=kk+kspan
731 k2=0
732 928 k2=k2+1
733 at(k2)=a(k1)
734 bt(k2)=b(k1)
735 k1=k1-inc
736 if(k1 .ne. kk) go to 928
737 932 k1=kk+kspan
738 k2=k1-jc*(k+np(k))
739 k=-np(k)
740 936 a(k1)=a(k2)
741 b(k1)=b(k2)
742 k1=k1-inc
743 k2=k2-inc
744 if(k1 .ne. kk) go to 936
745 kk=k2
746 if(k .ne. j) go to 932
747 k1=kk+kspan
748 k2=0
749 940 k2=k2+1
750 a(k1)=at(k2)
751 b(k1)=bt(k2)
752 k1=k1-inc
753 if(k1 .ne. kk) go to 940
754 if(jj .ne. 0) go to 926
755 if(j .ne. 1) go to 924
756 950 j=k3+1
757 nt=nt-kspnn
758 ii=nt-inc+1
759 if(nt .ge. 0) go to 924
760 return
761 ! error finish, insufficient array storage
762 998 isn=0
763 call mpistop("array bounds exceeded within subroutine fft")
764 end subroutine fft_raw
765
766end module mod_fft
subroutine, public mpistop(message)
Exit MPI-AMRVAC with an error message.
Self-contained complex FFT utilities based on the mixed-radix Singleton transform historically embedd...
Definition mod_fft.t:3
subroutine, public fft_2d_real_imag(ar, ai, inverse)
In-place two-dimensional FFT on split real/imaginary storage. This avoids allocation and copying in r...
Definition mod_fft.t:183
subroutine, public fft_raw(a, b, ntot, n, nspan, isn)
Definition mod_fft.t:208
subroutine, public fft_2d(data, inverse)
In-place complex two-dimensional FFT. The inverse is normalized.
Definition mod_fft.t:154
character(len=128) function, public fft_factorization(n)
Human-readable prime factorization used in unsupported-size diagnostics.
Definition mod_fft.t:85
integer function, public fft_next_supported(n)
Definition mod_fft.t:75
logical function, public fft_size_supported(n)
Return whether the legacy mixed-radix workspace can handle a transform.
Definition mod_fft.t:21
subroutine, public fft_1d(data, inverse)
In-place complex one-dimensional FFT. The inverse is normalized.
Definition mod_fft.t:131