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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
!
! Copyright (C) 2016 Andrea Dal Corso
! 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 set_intq_nc()
!----------------------------------------------------------------------------
USE ions_base, ONLY : nat, ntyp => nsp, ityp
USE uspp_param, ONLY : upf
USE lrus, ONLY : intq, intq_nc
IMPLICIT NONE
INTEGER :: npe
INTEGER :: np, na
intq_nc=(0.d0,0.d0)
DO np = 1, ntyp
IF ( upf(np)%tvanp ) THEN
DO na = 1, nat
IF (ityp(na)==np) THEN
IF (upf(np)%has_so) THEN
CALL transform_intq_so(intq,na)
ELSE
CALL transform_intq_nc(intq,na)
END IF
END IF
END DO
END IF
END DO
RETURN
END SUBROUTINE set_intq_nc
!
!
!----------------------------------------------------------------------------
SUBROUTINE transform_intq_so(intq,na)
!----------------------------------------------------------------------------
!
! This routine multiply intq by the identity and the Pauli
! matrices, rotate it as appropriate for the spin-orbit case
! and saves it in intq_nc.
!
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ityp
USE uspp_param, ONLY : nh, nhm
USE noncollin_module, ONLY : npol, nspin_mag
USE spin_orb, ONLY : fcoef, domag
USE lrus, ONLY : intq_nc
!
IMPLICIT NONE
COMPLEX(DP) :: intq(nhm,nhm,nat)
INTEGER :: na
!
! ... local variables
!
INTEGER :: ih, jh, lh, kh, np, npert, is1, is2, ijs
LOGICAL :: same_lj
np=ityp(na)
DO ih = 1, nh(np)
DO kh = 1, nh(np)
IF (same_lj(kh,ih,np)) THEN
DO jh = 1, nh(np)
DO lh= 1, nh(np)
IF (same_lj(lh,jh,np)) THEN
ijs=0
DO is1=1,npol
DO is2=1,npol
ijs=ijs+1
intq_nc(ih,jh,na,ijs)= &
intq_nc(ih,jh,na,ijs) + intq (kh,lh,na)* &
(fcoef(ih,kh,is1,1,np)*fcoef(lh,jh,1,is2,np) + &
fcoef(ih,kh,is1,2,np)*fcoef(lh,jh,2,is2,np) )
ENDDO
ENDDO
ENDIF
ENDDO
ENDDO
ENDIF
ENDDO
ENDDO
!
RETURN
END SUBROUTINE transform_intq_so
!
!
!----------------------------------------------------------------------------
SUBROUTINE transform_intq_nc(intq,na)
!----------------------------------------------------------------------------
!
! This routine multiply intq by the identity and the Pauli
! matrices and saves it in intq_nc.
!
USE kinds, ONLY : DP
USE ions_base, ONLY : nat, ityp
USE uspp_param, ONLY : nh, nhm
USE lrus, ONLY : intq_nc
!
IMPLICIT NONE
INTEGER :: na
COMPLEX(DP) :: intq(nhm,nhm,nat)
!
! ... local variables
!
INTEGER :: ih, jh, np
np=ityp(na)
DO ih = 1, nh(np)
DO jh = 1, nh(np)
intq_nc(ih,jh,na,1)=intq(ih,jh,na)
intq_nc(ih,jh,na,4)=intq(ih,jh,na)
END DO
END DO
RETURN
END SUBROUTINE transform_intq_nc
|
