1!
2! Copyright (C) 2001-2019 Quantum ESPRESSO 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!----------------------------------------------------------------------------
9!
10! ... Common variables for LR_Modules routines
11!
12MODULE qpoint
13  !
14  USE kinds,      ONLY : DP
15  !
16  ! ... The variables needed to specify various indices,
17  ! ... number of plane waves and k points and their coordiantes.
18  !
19  SAVE
20  !
21  INTEGER, POINTER :: igkq(:)     ! npwx)
22  ! correspondence k+q+G <-> G
23  INTEGER :: nksq, npwq, nksqtot
24  ! the real number of k points
25  ! the number of plane waves for q
26  ! the total number of q points
27  INTEGER, ALLOCATABLE :: ikks(:), ikqs(:)
28  ! the index of k point in the list of k
29  ! the index of k+q point in the list of k
30  REAL (DP) :: xq(3)
31  ! the coordinates of the q point
32  COMPLEX (DP), ALLOCATABLE :: eigqts(:) ! nat)
33  ! the phases associated to the q
34  REAL (DP), ALLOCATABLE :: xk_col(:,:)
35  !
36END MODULE qpoint
37!
38!
39!
40MODULE qpoint_aux
41  USE kinds,      ONLY : DP
42  USE becmod,     ONLY : bec_type
43  SAVE
44
45  INTEGER, ALLOCATABLE :: ikmks(:)    ! index of -k for magnetic calculations
46
47  INTEGER, ALLOCATABLE :: ikmkmqs(:)  ! index of -k-q for magnetic calculations
48
49  TYPE(bec_type), ALLOCATABLE :: becpt(:), alphapt(:,:)
50
51END MODULE qpoint_aux
52!
53!
54MODULE control_lr
55  !
56  USE kinds,      ONLY : DP
57  !
58  ! ... The variables controlling the run of linear response codes
59  !
60  SAVE
61  !
62  INTEGER, ALLOCATABLE :: nbnd_occ(:)  ! occupied bands in metals
63  INTEGER, ALLOCATABLE :: ofsbeta(:)   ! for each atom gives the offset of beta functions
64  REAL(DP) :: alpha_pv       ! the alpha value for shifting the bands
65  LOGICAL  :: lgamma         ! if .TRUE. this is a q=0 computation
66  LOGICAL  :: lrpa           ! if .TRUE. uses the Random Phace Approximation
67  REAL(DP) :: ethr_nscf      ! convergence threshol for KS eigenvalues in the
68                             ! NSCF calculation
69  ! Sternheimer case
70  LOGICAL :: lgamma_gamma,&! if .TRUE. this is a q=0 computation with k=0 only
71             convt,       &! if .TRUE. the phonon has converged
72             ext_recover, &! if .TRUE. there is a recover file
73             lnoloc        ! if .TRUE. calculates the dielectric constant
74                           ! neglecting local field effects
75  INTEGER :: rec_code=-1000,    & ! code for recover
76             rec_code_read=-1000  ! code for recover. Not changed during the run
77  CHARACTER(LEN=256) :: flmixdpot
78  REAL(DP) :: tr2_ph  ! threshold for phonon calculation
79  REAL(DP) :: alpha_mix(100)  ! the mixing parameter
80  INTEGER :: niter_ph         ! maximum number of iterations (read from input)
81
82  !
83END MODULE control_lr
84!
85MODULE eqv
86  !
87  USE kinds,  ONLY : DP
88  !
89  ! ... The variables describing the linear response problem
90  !
91  SAVE
92  !
93  COMPLEX (DP), POINTER :: evq(:,:)
94  ! the wavefunctions at point k+q
95  COMPLEX (DP), ALLOCATABLE :: dvpsi(:,:), dpsi(:,:), drhoscfs (:,:,:)
96  ! the product of dV psi
97  ! the change of the wavefunctions
98  REAL (DP), ALLOCATABLE :: dmuxc(:,:,:)        ! nrxx, nspin, nspin)
99  ! the derivative of the xc potential
100  REAL (DP), ALLOCATABLE, TARGET :: vlocq(:,:)  ! ngm, ntyp)
101  ! the local potential at q+G
102  !
103END MODULE eqv
104!
105MODULE gc_lr
106  !
107  USE kinds, ONLY : DP
108  !
109  ! ... The variables needed for gradient corrected calculations
110  !
111  SAVE
112  !
113  REAL (DP), ALLOCATABLE :: &
114       grho(:,:,:),    &! gradient of the unperturbed density  (3,nrxx,nspin)
115       gmag(:,:,:),    &! 3, nrxx, nspin)
116       vsgga(:),       &! nrxx)
117       segni(:),       &! nrxx)
118       dvxc_rr(:,:,:), &! derivatives of the E_xc functional w.r.t. r and s
119       dvxc_sr(:,:,:), &! r=rho and s=|grad(rho)|
120       dvxc_ss(:,:,:), &! dimensions: (nrxx, nspin, nspin)
121       dvxc_s(:,:,:)
122  !
123  ! in the noncollinear case gmag contains the gradient of the magnetization
124  ! grho the gradient of rho+ and of rho-, the eigenvalues of the spin density
125  ! vsgga= 0.5* (V_up-V_down) to be used in the calculation of the change
126  ! of the exchange and correlation magnetic field.
127  !
128END MODULE gc_lr
129!
130MODULE lr_symm_base
131  !
132  USE kinds,  ONLY : DP
133  !
134  ! ... The variables needed to describe the modes and the small group of q
135  !
136  SAVE
137  !
138  INTEGER :: irgq(48), nsymq=0, irotmq
139  ! selects the operations of the small group
140  ! the number of symmetry of the small group
141  ! selects the symmetry sending q <-> -q+G
142  REAL (DP), ALLOCATABLE :: rtau(:,:,:) !3, 48, nat)
143  ! coordinates of direct translations
144  REAL (DP) :: gi(3,48), gimq(3)
145  ! the possible G associated to each symmetry
146  ! the G associated to the symmetry q<->-q+G
147  LOGICAL :: minus_q, & ! if .TRUE. there is the symmetry sending q<->-q
148             invsymq    ! if .TRUE. the small group of q has inversion
149  !
150END MODULE lr_symm_base
151!
152MODULE lrus
153  !
154  USE kinds,  ONLY : DP
155  USE becmod, ONLY : bec_type
156  !
157  ! ... These are additional variables needed for the linear response
158  ! ... with US pseudopotentials and a generic perturbation Delta Vscf
159  !
160  SAVE
161  !
162  COMPLEX (DP), ALLOCATABLE :: &
163       int3(:,:,:,:,:),     &! nhm, nhm, nat, nspin, npert)
164       int3_paw(:,:,:,:,:), &! nhm, nhm, nat, nspin, npert)
165       int3_nc(:,:,:,:,:),  &! nhm, nhm, nat, nspin, npert)
166       intq(:,:,:),         &! nhm, nhm, nat)
167       intq_nc(:,:,:,:)      ! nhm, nhm, nat, nspin)
168  ! int3 -> \int (Delta V_Hxc) Q d^3r
169  ! similarly for int_nc while
170  ! int3_paw contains Delta (D^1-\tilde D^1)
171  ! intq integral of e^iqr Q
172  ! intq_nc integral of e^iqr Q in the noncollinear case
173  !
174  REAL (DP), ALLOCATABLE ::    dpqq(:,:,:,:)       ! nhm, nhm, 3, ntyp)
175  COMPLEX (DP), ALLOCATABLE :: dpqq_so(:,:,:,:,:)  ! nhm, nhm, nspin, 3, ntyp)
176  ! dpqq and dpqq_so: dipole moment of each Q multiplied by the fcoef factors
177  !
178  type (bec_type), ALLOCATABLE, TARGET :: becp1(:) ! nksq)
179  ! becp1 contains < beta_n | psi_i >
180  !
181  REAL (DP),    ALLOCATABLE :: bbg(:,:)      ! nkb, nkb)
182  ! for gamma_only
183  COMPLEX (DP), ALLOCATABLE :: bbk(:,:,:)    ! nkb, nkb, nks)
184  ! for k points
185  COMPLEX (DP), ALLOCATABLE :: bbnc(:,:,:) ! nkb*npol, nkb*npol, nks)
186  ! for the noncollinear case
187  ! bbg = < beta^N_i | beta^P_j >
188  ! bbg/bbk/bbnc are the scalar products of beta functions
189  ! localized on atoms N and P.
190  !
191END MODULE lrus
192!
193MODULE units_lr
194  !
195  USE kinds,  ONLY : DP
196  !
197  ! ... These are the units used in the linear response calculations
198  !
199  SAVE
200  !
201  INTEGER :: iuwfc,   & ! unit for wavefunctions
202             lrwfc,   & ! the length of wavefunction record
203             iuatwfc, & ! unit for atomic wavefunctions
204             iuatswfc   ! unit for atomic wavefunctions * S
205  !
206END MODULE units_lr
207