Line data    Source code

       1             : MODULE m_fft2d
       2             : CONTAINS
       3       49200 :    SUBROUTINE fft2d(stars,afft2,bfft2,fg,isn,firstderiv,secondderiv,cell )
       4             :       !!
       5             :       !!
       6             :     !*************************************************************
       7             :     !*                                                           *
       8             :     !* interface for fg2(star) -- FFT --> gfft (r)     (isn=+1)  *
       9             :     !*            or gfft (r)  -- FFT --> fg2(star)    (isn=-1)  *
      10             :     !*                                                           *
      11             :     !* dimension of gfft2 is (3*stars%mx1 x 3*stars%mx2)                     *
      12             :     !* afft/bfft contain the real/imaginary part of gfft         *
      13             :     !* stars%igfft2(i,1) is the pointer from the G-sphere to stars     *
      14             :     !* stars%igfft2(i,2) is the pointer from the G-sphere to fft-grid  *
      15             :     !* stars%pgfft2(i)   contains the phases of the G-vectors of sph.  *
      16             :     !*                                                           *
      17             :     !*************************************************************
      18             :       USE m_types_fftgrid
      19             :       USE m_types
      20             : 
      21             :       IMPLICIT NONE
      22             : 
      23             :       TYPE(t_stars), INTENT(IN) :: stars
      24             :       
      25             :       INTEGER, INTENT (IN)   :: isn
      26             :       REAL                   :: afft2(0:9*stars%mx1*stars%mx2-1),bfft2(0:9*stars%mx1*stars%mx2-1)
      27             :       COMPLEX                :: fg(:)
      28             :     
      29             :       REAL,         OPTIONAL, INTENT(IN) :: firstderiv(3),secondderiv(3)
      30             :       TYPE(t_cell), OPTIONAL, INTENT(IN) :: cell
      31             :     
      32      393600 :       TYPE(t_fftgrid) :: grid
      33             :       
      34             :       INTEGER :: i
      35             :    
      36      196800 :       CALL grid%init([3*stars%mx1,3*stars%mx2,1])
      37             : 
      38       49200 :       IF (isn>0) THEN
      39             :         !  ---> put stars onto the fft-grid
      40       37000 :         CALL grid%putFieldOnGrid(stars,fg,cell,firstderiv=firstderiv,secondderiv=secondderiv,l_2d=.TRUE.)
      41             :         ELSE
      42    22047400 :         grid%grid=cmplx(afft2,bfft2)
      43             :         END IF
      44             : 
      45       49200 :         CALL grid%perform_fft(forward=(isn<0))
      46             :     
      47       49200 :         IF (isn>0) THEN
      48    87490000 :                 afft2 =  REAL(grid%grid)
      49    87490000 :                 bfft2 = AIMAG(grid%grid)
      50             :       ELSE
      51       12200 :          CALL grid%takeFieldFromGrid(stars,fg,l_2d=.TRUE.)
      52             :          !Scaling by stars%nstr is already done in previous call
      53             :          !IF (PRESENT(scaled)) THEN
      54             :          !   IF (.not.scaled) fg3 = fg3*stars%nstr
      55             :          !ENDIF
      56             :       END IF   
      57       49200 :         IF (isn<0) THEN
      58             :         !  ---> collect stars from the fft-grid
      59       12200 :                         CALL grid%takeFieldFromGrid(stars, fg, l_2d=.TRUE.)
      60             :         END IF
      61       49200 :   END SUBROUTINE fft2d
      62             : END MODULE m_fft2d