1!
2! Copyright (C) 2001 PWSCF group
3! This file is distributed under the terms of the
4! GNU General Public License. See the file `License'
5! in the root directory of the present distribution,
6! or http://www.gnu.org/copyleft/gpl.txt .
7!
8!------------------------------------------------------------------------------
9SUBROUTINE set_vrs( vrs, vltot, vr, kedtau, kedtaur, nrxx, nspin, doublegrid )
10  !-----------------------------------------------------------------------------
11  !! Set the total local potential vrs on the smooth mesh to be used in
12  !! \(\texttt{h_psi}\), adding the (spin dependent) scf (H+xc) part and
13  !! the sum of all the local pseudopotential contributions.
14  !
15  USE kinds
16  USE funct,    ONLY : dft_is_meta
17  USE fft_base, ONLY : dffts
18  !
19  IMPLICIT NONE
20  !
21  INTEGER :: nspin
22  !! input: number of spin components: 1 if lda, 2 if lsd, 4 if noncolinear
23  INTEGER :: nrxx
24  !! input: the fft grid dimension
25  REAL(DP) :: vrs(nrxx,nspin)
26  !! output: total local potential on the smooth grid vrs=vltot+vr
27  REAL(DP) :: vltot(nrxx)
28  !! input: the total local pseudopotential
29  REAL(DP) :: vr(nrxx,nspin)
30  !! input: the scf(H+xc) part of the local potential
31  REAL(DP) :: kedtau(dffts%nnr,nspin)
32  !! position dependent kinetic energy enhancement factor
33  REAL(DP) :: kedtaur(nrxx,nspin)
34  !! the kinetic energy density in R-space
35  LOGICAL :: doublegrid
36  ! input: true if a doublegrid is used
37  !
38  CALL sum_vrs( nrxx, nspin, vltot, vr, vrs )
39  !
40  CALL interpolate_vrs( nrxx, nspin, doublegrid, kedtau, kedtaur, vrs )
41  !
42  RETURN
43  !
44END SUBROUTINE set_vrs
45!
46!
47!--------------------------------------------------------------------
48SUBROUTINE sum_vrs( nrxx, nspin, vltot, vr, vrs )
49  !--------------------------------------------------------------------
50  !! Accumulates local potential contributions into vrs (the total local potential).
51  !
52  USE kinds
53  !
54  IMPLICIT NONE
55  !
56  INTEGER :: nspin
57  !! input: number of spin components: 1 if lda, 2 if lsd, 4 if noncolinear
58  INTEGER :: nrxx
59  !! input: the fft grid dimension
60  REAL(DP) :: vrs(nrxx,nspin)
61  !! output: total local potential on the smooth grid:
62  !! \(\text{vrs\}=\text{vltot}+\text{vr}\)
63  REAL(DP) :: vltot(nrxx)
64  !! input: the total local pseudopotential
65  REAL(DP) :: vr(nrxx,nspin)
66  !! input: the scf(H+xc) part of the local potential
67  !
68  ! ... local variable
69  !
70  INTEGER :: is
71  !
72  !
73  DO is = 1, nspin
74     !
75     ! define the total local potential (external + scf) for each spin ...
76     !
77     IF (is > 1 .AND. nspin == 4) THEN
78        !
79        ! noncolinear case: only the first component contains vltot
80        !
81        vrs(:,is) = vr(:,is)
82     ELSE
83        vrs(:,is) = vltot(:) + vr(:,is)
84     ENDIF
85     !
86  ENDDO
87  !
88  RETURN
89  !
90END SUBROUTINE sum_vrs
91!
92!--------------------------------------------------------------------------
93SUBROUTINE interpolate_vrs( nrxx, nspin, doublegrid, kedtau, kedtaur, vrs )
94  !--------------------------------------------------------------------------
95  !! Interpolates local potential on the smooth mesh if necessary.
96  !
97  USE kinds
98  USE funct,           ONLY : dft_is_meta
99  USE fft_base,        ONLY : dffts, dfftp
100  USE fft_interfaces,  ONLY : fft_interpolate
101  !
102  IMPLICIT NONE
103  !
104  INTEGER :: nspin
105  !! input: number of spin components: 1 if lda, 2 if lsd, 4 if noncolinear
106  INTEGER :: nrxx
107  !! input: the fft grid dimension
108  REAL(DP) :: vrs(nrxx,nspin)
109  !! output: total local potential interpolated on the smooth grid
110  REAL(DP) :: kedtau(dffts%nnr,nspin)
111  !! position dependent kinetic energy enhancement factor
112  REAL(DP) :: kedtaur(nrxx,nspin)
113  !! the kinetic energy density in R-space
114  LOGICAL :: doublegrid
115  !! input: true if a doublegrid is used
116  !
117  ! ... local variable
118  !
119  INTEGER :: is
120  !
121  ! ... interpolate it on the smooth mesh if necessary
122  !
123  DO is = 1, nspin
124     IF (doublegrid) CALL fft_interpolate( dfftp, vrs(:, is), dffts, vrs(:, is) )
125     IF (dft_is_meta()) CALL fft_interpolate( dfftp, kedtaur(:,is), dffts, kedtau(:,is) )
126  ENDDO
127  !
128  RETURN
129  !
130END SUBROUTINE interpolate_vrs
131