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 : !!***
|