convol.f90 1.86 KB
Newer Older
 Markus Betzinger committed Apr 26, 2016 1 2 3 4 5  MODULE m_convol CONTAINS SUBROUTINE convol(& & stars, & & fg3,&  Gregor Michalicek committed Feb 13, 2017 6  & ag3,ufft&  Markus Betzinger committed Apr 26, 2016 7 8 9 10  & ) !************************************************************ !* *  Gregor Michalicek committed Feb 13, 2017 11 12 13 !* calculate f(G) = \sum_G' U(G - G') a(G') * !* * !* U is already given on the real space mesh as U(r) *  Markus Betzinger committed Apr 26, 2016 14 15 16 17 18 !* * !* ag3(star) -- FFT --> gfft(r,1) * !* gfft(r,1)=gfft(r,1) * U (r) * !* fg3(star) <- FFT --- gfft(r,1) * !* *  Gregor Michalicek committed Feb 13, 2017 19 !* dimension of gfft is *  Gregor Michalicek committed Feb 13, 2017 20 !* (3*stars%mx1 x 3*stars%mx2 x 3*stars%mx3) *  Markus Betzinger committed Apr 26, 2016 21 22 23 24 25 26 27 !* * !************************************************************ USE m_types USE m_fft3d IMPLICIT NONE TYPE(t_stars),INTENT(IN) :: stars  Gregor Michalicek committed Feb 13, 2017 28   Daniel Wortmann committed Feb 13, 2017 29 30  COMPLEX, INTENT (IN) :: ag3(stars%ng3) COMPLEX, INTENT (OUT) :: fg3(stars%ng3)  Gregor Michalicek committed Feb 13, 2017 31  REAL, INTENT (IN) :: ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1)  Markus Betzinger committed Apr 26, 2016 32 33 34 35  INTEGER i,ifftd REAL, ALLOCATABLE :: gfft(:,:)  Daniel Wortmann committed Feb 13, 2017 36  ifftd=27*stars%mx1*stars%mx2*stars%mx3  Markus Betzinger committed Apr 26, 2016 37 38 39 40 41 42 43 44 45  ALLOCATE (gfft(0:ifftd-1,2)) CALL fft3d(& & gfft(0,1),gfft(0,2),& & ag3,& & stars,+1) DO i=0,ifftd-1  Gregor Michalicek committed Feb 13, 2017 46  gfft(i,:)=gfft(i,:)*ufft(i)  Markus Betzinger committed Apr 26, 2016 47 48 49 50 51 52 53 54 55 56 57 58 59  ENDDO CALL fft3d(& & gfft(0,1),gfft(0,2),& & fg3,& & stars,-1) fg3(:stars%ng3)=fg3(:stars%ng3)*stars%nstr(:stars%ng3) DEALLOCATE (gfft) END SUBROUTINE convol END MODULE m_convol