1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
!
! Copyright (C) 2016 Quantum ESPRESSO Foundation
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
! or http://www.gnu.org/copyleft/gpl.txt .
!
!-----------------------------------------------------------------------
subroutine h_prec (ik, evq, h_diag)
!-----------------------------------------------------------------------
!
! ... Compute the precondition vector h_diag used in the solution of the
! ... linear system - On input:
! ... ik index of k-point
! ... evq wavefunction at k+q point
!... h_diag must be allocated
! ... g2kin contains kinetic energy (k+q+G)^2 for the current k+q point
!
USE kinds, ONLY : dp
USE klist, ONLY : ngk
USE qpoint, ONLY : ikqs, ikks
USE wvfct, ONLY : g2kin, npwx, nbnd
USE gvect, ONLY : gstart
USE control_lr, ONLY : nbnd_occ
USE mp, ONLY : mp_sum
USE mp_bands, ONLY : intra_bgrp_comm
USE control_flags, ONLY : gamma_only
USE noncollin_module, ONLY : noncolin, npol
!
IMPLICIT NONE
INTEGER, INTENT(in) :: ik
COMPLEX(dp), INTENT(in) :: evq(npwx*npol, nbnd)
REAL(dp), INTENT(out) :: h_diag(npwx*npol, nbnd)
!
REAL(dp), ALLOCATABLE :: eprec(:)
COMPLEX(dp), ALLOCATABLE :: aux(:)
INTEGER :: ibnd, nbnd_, ig, ikk, ikq, npwq
REAL(dp), EXTERNAL :: DDOT
!
ikk = ikks(ik)
ikq = ikqs(ik)
npwq = ngk(ikq)
nbnd_=nbnd_occ(ikk)
ALLOCATE ( eprec(nbnd_) )
ALLOCATE ( aux(npol*npwx) )
DO ibnd = 1, nbnd_
aux=(0.d0,0.d0)
DO ig = 1, npwq
aux (ig) = g2kin (ig) * evq (ig, ibnd)
END DO
! NOTE: eprec(i) = 1.35*<\psi_i|Ek|\psi_i> is always real
IF (noncolin) THEN
DO ig = 1, npwq
aux (ig+npwx) = g2kin (ig)* evq (ig+npwx, ibnd)
END DO
eprec(ibnd) = DDOT(2*npwx*npol,evq(1,ibnd),1,aux(1),1)
ELSE IF ( gamma_only) THEN
eprec(ibnd) = 2.0_dp*DDOT(2*npwq,evq(1,ibnd),1,aux(1),1)
! the following line is actually not needed
! because q=0 in gamma-only case, so |k+q+G|=0 for G=0
IF (gstart==2) eprec(ibnd) = eprec(ibnd)-DBLE(evq(1,ibnd))*DBLE(aux(1))
ELSE
eprec(ibnd) = DDOT(2*npwq,evq(1,ibnd),1,aux(1),1)
END IF
eprec(ibnd) = 1.35_dp * eprec(ibnd)
!
END DO
DEALLOCATE (aux)
CALL mp_sum(eprec, intra_bgrp_comm)
!
h_diag=0.0_dp
DO ibnd = 1, nbnd_
DO ig = 1, npwq
! Diagonal preconditining:
! h_diag(G) = <Ek>/|k+q+G|^2 if |k+q+G|^2 .gt. <Ek>
! h_diag(G) = 1 otherwise
! written in this funny way because g2kin may be zero
h_diag(ig,ibnd)=1.0_dp/max(1.0_dp,g2kin(ig)/eprec(ibnd))
END DO
IF (noncolin) THEN
DO ig = 1, npwq
h_diag(ig+npwx,ibnd)=h_diag(ig,ibnd)
END DO
END IF
END DO
DEALLOCATE (eprec)
END SUBROUTINE h_prec
|
