21 integer,
intent(in) :: n
22 integer :: m,p,nleft,nfactors,square_free
34 if(mod(nleft,p)==0)
then
39 square_free=square_free*p
40 do while(mod(nleft,p)==0)
56 square_free=square_free*nleft
85 integer,
intent(in) :: n
86 character(len=128) :: description
87 character(len=24) :: item
88 integer :: left,p,power,used
92 write(description,
'(i0)') n
101 do while(mod(left,p)==0)
109 write(item,
'(i0,a,i0)') p,
'^',power
111 if(used>0) description=trim(description)//
' * '
112 description=trim(description)//trim(item)
122 write(item,
'(i0)') left
123 if(used>0) description=trim(description)//
' * '
124 description=trim(description)//trim(item)
126 if(len_trim(description)==0) description=
'1'
154 double complex,
intent(inout) :: data(:,:)
155 logical,
intent(in) :: inverse
156 double precision,
allocatable :: ar(:),ai(:)
157 integer :: n1,n2,ntot,isign
162 error stop
'fft_2d: unsupported transform size'
165 allocate(ar(ntot),ai(ntot))
166 ar=reshape(dble(data),[ntot])
167 ai=reshape(dimag(data),[ntot])
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)
251 double precision :: a(*),b(*)
255 dimension nfac(11),np(209)
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
276 c72=0.30901699437494742d0
277 s72=0.95105651629515357d0
278 s120=0.86602540378443865d0
279 rad=6.2831853071796d0
280 if(isn .ge. 0)
go to 10
290 radf=rad*dble(jc)*0.5d0
300 20
if(k-(k/16)*16 .eq. 0)
go to 15
307 30
if(mod(k,jj) .eq. 0)
go to 25
310 if(jj .le. k)
go to 30
311 if(k .gt. 4)
go to 40
316 40
if(k-(k/4)*4 .ne. 0)
go to 50
322 60
if(mod(k,j) .ne. 0)
go to 70
327 if(j .le. k)
go to 60
328 80
if(kt .eq. 0)
go to 100
333 if(j .ne. 0)
go to 90
335 100 sd=radf/dble(kspan)
340 if(nfac(i) .ne. 2)
go to 400
352 if(kk .le. nn)
go to 210
354 if(kk .le. jc)
go to 210
355 if(kk .gt. kspan)
go to 800
366 if(kk .lt. nt)
go to 230
370 if(kk .gt. k2)
go to 230
373 c1=2.d0-(ak**2+s1**2)
377 if(kk .lt. k2)
go to 230
380 if(kk .le. jc+jc)
go to 220
393 aj=(a(k1)-a(k2))*s120
394 bj=(b(k1)-b(k2))*s120
400 if(kk .lt. nn)
go to 320
402 if(kk .le. kspan)
go to 320
405 400
if(nfac(i) .ne. 4)
go to 600
425 if(isn .lt. 0)
go to 450
430 if(s1 .eq. 0.d0)
go to 460
431 430 a(k1)=akp*c1-bkp*s1
438 if(kk .le. nt)
go to 420
439 440 c2=c1-(cd*c1+sd*s1)
441 c1=2.d0-(c2**2+s1**2)
449 if(kk .le. kspan)
go to 420
451 if(kk .le. jc)
go to 410
452 if(kspan .eq. jc)
go to 800
458 if(s1 .ne. 0)
go to 430
466 if(kk .le. nt)
go to 420
504 if(kk .lt. nn)
go to 520
506 if(kk .le. kspan)
go to 520
512 if(k .eq. 3)
go to 320
513 if(k .eq. 5)
go to 510
514 if(k .eq. jf)
go to 640
519 if(jf .gt. maxf)
go to 998
523 630 ck(j)=ck(k)*c1+sk(k)*s1
524 sk(j)=ck(k)*s1-sk(k)*c1
529 if(j .lt. k)
go to 630
548 if(k1 .lt. k2)
go to 650
569 if(jj .gt. jf) jj=jj-jf
570 if(k .lt. jf)
go to 670
577 if(j .lt. k)
go to 660
579 if(kk .le. nn)
go to 640
581 if(kk .le. kspan)
go to 640
583 700
if(i .eq. m)
go to 800
594 if(kk .le. nt)
go to 730
599 if(kk .le. kspnn)
go to 730
602 c1=2.d0-(c2**2+s1**2)
606 if(kk .le. kspan)
go to 720
608 if(kk .le. jc+jc)
go to 710
613 if(kt .eq. 0)
go to 890
618 810 np(j+1)=np(j)/nfac(j)
619 np(k)=np(k+1)*nfac(j)
622 if(j .lt. k)
go to 810
628 if(n .ne. ntot)
go to 850
638 if(k2 .lt. ks)
go to 820
642 if(k2 .gt. np(j))
go to 830
644 840
if(kk .lt. k2)
go to 820
647 if(k2 .lt. ks)
go to 840
648 if(kk .lt. ks)
go to 830
661 if(kk .lt. k)
go to 860
664 if(kk .lt. nt)
go to 850
667 if(k2 .lt. ks)
go to 850
671 if(k2 .gt. np(j))
go to 870
673 880
if(kk .lt. k2)
go to 850
676 if(k2 .lt. ks)
go to 880
677 if(kk .lt. ks)
go to 870
679 890
if(2*kt+1 .ge. m)
return
684 900 nfac(j)=nfac(j)*nfac(j+1)
686 if(j .ne. kt)
go to 900
689 if(nn .gt. maxp)
go to 998
698 if(jj .ge. k2)
go to 902
704 if(j .le. nn)
go to 904
711 if(kk .ne. j)
go to 910
715 if(kk .lt. 0)
go to 914
716 if(kk .ne. j)
go to 910
718 if(j .ne. nn)
go to 914
723 if(np(j) .lt. 0)
go to 924
726 if(jj .gt. maxf) kspan=maxf
736 if(k1 .ne. kk)
go to 928
744 if(k1 .ne. kk)
go to 936
746 if(k .ne. j)
go to 932
753 if(k1 .ne. kk)
go to 940
754 if(jj .ne. 0)
go to 926
755 if(j .ne. 1)
go to 924
759 if(nt .ge. 0)
go to 924
763 call mpistop(
"array bounds exceeded within subroutine fft")
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...