Branch data     Line data    Source code

       1                 :             : !!****m* ABINIT/m_vcoul/m_cutoff_sphere
       2                 :             : !! NAME
       3                 :             : !!  m_cutoff_sphere
       4                 :             : !!
       5                 :             : !! FUNCTION
       6                 :             : !!
       7                 :             : !! SOURCE
       8                 :             : 
       9                 :             : #if defined HAVE_CONFIG_H
      10                 :             : #include "config.h"
      11                 :             : #endif
      12                 :             : 
      13                 :             : 
      14                 :             : module m_cutoff_sphere
      15                 :             : 
      16                 :             :  use defs_basis
      17                 :             :  use m_abicore
      18                 :             :  use m_geometry,        only : normv
      19                 :             : 
      20                 :             :  implicit none
      21                 :             : 
      22                 :             :  private
      23                 :             : 
      24                 :             :  public ::  cutoff_sphere
      25                 :             : !!***
      26                 :             : 
      27                 :             : CONTAINS  !========================================================================================
      28                 :             : !!***
      29                 :             : 
      30                 :             : !!****f* m_cutoff/cutoff_sphere
      31                 :             : !! NAME
      32                 :             : !! cutoff_sphere
      33                 :             : !!
      34                 :             : !! FUNCTION
      35                 :             : !!  Calculate the Fourier transform of the Coulomb interaction with a spherical cutoff in real-space.
      36                 :             : !!
      37                 :             : !!   $ v_{cut}(G)= \frac{4\pi}{|q+G|^2} [ 1-cos(|q+G|*R_cut) ] $  (1)
      38                 :             : !!
      39                 :             : !!  For |q|<small and G=0 we use 2pi.R_cut^2, namely we consider the limit q-->0 of Eq. (1)
      40                 :             : !!
      41                 :             : !! INPUTS
      42                 :             : !!  qpt(3)=q-point where the cutoff Coulomb is required.
      43                 :             : !!  ngvec=Number of G vectors
      44                 :             : !!  gvec(3,ngvec)=G vectors in reduced coordinates.
      45                 :             : !!  gmet(3,3)=Metric in reciprocal space.
      46                 :             : !!  rcut=Cutoff radius of the sphere.
      47                 :             : !!
      48                 :             : !! OUTPUT
      49                 :             : !!  vc_cut(ngvec)=Fourier components of the effective Coulomb interaction.
      50                 :             : !!
      51                 :             : !! SOURCE
      52                 :             : 
      53                 :         137 : subroutine cutoff_sphere(qpt, ngvec, gvec, gmet, rcut, vc_cut)
      54                 :             : 
      55                 :             : !Arguments ------------------------------------
      56                 :             : !scalars
      57                 :             :  integer,intent(in) :: ngvec
      58                 :             :  real(dp),intent(in) :: rcut
      59                 :             : !arrays
      60                 :             :  integer,intent(in) :: gvec(3,ngvec)
      61                 :             :  real(dp),intent(in) :: gmet(3,3),qpt(3)
      62                 :             :  real(dp),intent(out) :: vc_cut(ngvec)
      63                 :             : 
      64                 :             : !Local variables-------------------------------
      65                 :             : !scalars
      66                 :             :  integer :: ig,igs
      67                 :             :  real(dp) :: qpg
      68                 :             :  logical :: ltest
      69                 :             : 
      70                 :             : !************************************************************************
      71                 :             : 
      72                 :             :  !------------------------------------------------------------
      73                 :             :  ! Code modification by Bruno Rousseau, Montreal, 06/11/2013
      74                 :             :  !------------------------------------------------------------
      75                 :             :  !
      76                 :             :  ! In order for the code below to run in parallel using MPI
      77                 :             :  ! within the gwls code (by Laflamme-Jansen, Cote and Rousseau)
      78                 :             :  ! the ABI_CHECK below must be removed.
      79                 :             :  !
      80                 :             :  ! The ABI_CHECK below will fail if G-vectors are distributed on
      81                 :             :  ! many processors, as only the master process has G=(0,0,0).
      82                 :             :  !
      83                 :             :  ! The test does not seem necessary; IF a process has G=(0,0,0)
      84                 :             :  ! (namely, the master process), then it will be the first G vector.
      85                 :             :  ! If a process does not have G=(0,0,0) (ie, all the other processes),
      86                 :             :  ! then they don't need to worry about the G-> 0 limit.
      87                 :             :  !
      88                 :             : 
      89   [ +  +  +  - ]:         548 :  ltest = ALL(gvec(:,1) == 0)
      90                 :             :  !ABI_CHECK(ltest,'The first G vector should be Gamma')
      91                 :             : 
      92                 :         137 :  igs=1
      93   [ +  -  +  + ]:         137 :  if (ltest .and. normv(qpt, gmet, 'G') < tol4) then ! For small q and G=0, use the limit q-->0.
      94                 :          92 :    vc_cut(1)=two_pi*rcut**2
      95                 :          92 :    igs=2
      96                 :             :  end if
      97         [ +  + ]:      144966 :  do ig=igs,ngvec
      98         [ +  + ]:      579316 :    qpg = normv(qpt(:) + gvec(:,ig), gmet, 'G')
      99                 :      144966 :    vc_cut(ig) = four_pi* (one-COS(rcut*qpg)) / qpg**2
     100                 :             :  end do
     101                 :             : 
     102                 :         137 : end subroutine cutoff_sphere
     103                 :             : !!***
     104                 :             : 
     105                 :             : end module m_cutoff_sphere
     106                 :             : !!***