convol.f90 1.86 KB
Newer Older
1 2 3 4 5
      MODULE m_convol
      CONTAINS
      SUBROUTINE convol(&
     &                  stars, &
     &                  fg3,&
6
     &                  ag3,ufft&
7 8 9 10
     &                   )

!************************************************************
!*                                                          *
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)        *
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)                     *
!*                                                          *
19
!* dimension of gfft is                                     *
20
!* (3*stars%mx1 x 3*stars%mx2 x 3*stars%mx3)                *
21 22 23 24 25 26 27
!*                                                          *
!************************************************************
      USE m_types
      USE m_fft3d
      IMPLICIT NONE

      TYPE(t_stars),INTENT(IN) :: stars
28

29 30
      COMPLEX, INTENT (IN)     :: ag3(stars%ng3)
      COMPLEX, INTENT (OUT)    :: fg3(stars%ng3)
31
      REAL,    INTENT (IN)     :: ufft(0:27*stars%mx1*stars%mx2*stars%mx3-1)
32 33 34 35

      INTEGER i,ifftd
      REAL, ALLOCATABLE :: gfft(:,:)

36
      ifftd=27*stars%mx1*stars%mx2*stars%mx3
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
46
        gfft(i,:)=gfft(i,:)*ufft(i)
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