Line data Source code
1 : MODULE m_orbmom
2 : ! ***************************************************************
3 : ! perform the sum over m (for each l) and bands to set up the
4 : ! coefficient of spherical contribution to orbital moment.
5 : ! all quantities are in the local spin-frame
6 : ! ***************************************************************
7 :
8 : CONTAINS
9 1566 : SUBROUTINE orbmom(atoms,ne,we,ispin,eigVecCoeffs,orb)
10 :
11 : !USE m_types, ONLY : t_orb,t_orbl,t_orblo
12 : USE m_types
13 : IMPLICIT NONE
14 : TYPE(t_atoms), INTENT(IN) :: atoms
15 : TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
16 : ! ..
17 : ! .. Scalar Arguments ..
18 : INTEGER, INTENT (IN) :: ne, ispin
19 : ! ..
20 : ! .. Array Arguments ..
21 : REAL, INTENT (IN) :: we(:)!(nobd)
22 : TYPE (t_orb), INTENT (INOUT) :: orb
23 :
24 : ! .. Local Scalars ..
25 : INTEGER i,l,lm ,n,na,natom,ilo,ilop,m
26 : COMPLEX,PARAMETER:: czero= CMPLX(0.0,0.0)
27 :
28 1566 : natom = 0
29 4388 : DO n = 1,atoms%ntype
30 7214 : DO na = 1,atoms%neq(n)
31 2826 : natom = natom + 1
32 :
33 28448 : DO l = 0,atoms%lmax(n)
34 : ! -----> sum over m
35 261178 : DO m = -l,l
36 232730 : lm = l* (l+1) + m
37 : ! -----> sum over occupied bands
38 3803508 : DO i = 1,ne
39 : ! coeff. for lz ->
40 : orb%uu(l,m,n,ispin) = orb%uu(l,m,n,ispin) + we(i)*eigVecCoeffs%abcof(i,lm,0,natom,ispin)*&
41 3545156 : CONJG(eigVecCoeffs%abcof(i,lm,0,natom,ispin))
42 : orb%dd(l,m,n,ispin) = orb%dd(l,m,n,ispin) + we(i)*eigVecCoeffs%abcof(i,lm,1,natom,ispin)*&
43 3545156 : CONJG(eigVecCoeffs%abcof(i,lm,1,natom,ispin))
44 : ! coeff. for l+ <M'|l+|M> with respect to M ->
45 3545156 : IF (m.NE.l) THEN
46 : orb%uup(l,m,n,ispin) = orb%uup(l,m,n,ispin) + we(i)*eigVecCoeffs%abcof(i,lm,0,natom,ispin)*&
47 3159400 : CONJG(eigVecCoeffs%abcof(i,lm+1,0,natom,ispin))
48 : orb%ddp(l,m,n,ispin) = orb%ddp(l,m,n,ispin) + we(i)*eigVecCoeffs%abcof(i,lm,1,natom,ispin)*&
49 3159400 : CONJG(eigVecCoeffs%abcof(i,lm+1,1,natom,ispin))
50 : ELSE
51 385756 : orb%uup(l,m,n,ispin) = czero
52 385756 : orb%ddp(l,m,n,ispin) = czero
53 : ENDIF
54 : ! coeff. for l- <M'|l-|M> with respect to M ->
55 3777886 : IF (m.NE.-l) THEN
56 : orb%uum(l,m,n,ispin) = orb%uum(l,m,n,ispin) + we(i)*eigVecCoeffs%abcof(i,lm,0,natom,ispin)*&
57 3159400 : CONJG(eigVecCoeffs%abcof(i,lm-1,0,natom,ispin))
58 : orb%ddm(l,m,n,ispin) = orb%ddm(l,m,n,ispin) + we(i)*eigVecCoeffs%abcof(i,lm,1,natom,ispin)*&
59 3159400 : CONJG(eigVecCoeffs%abcof(i,lm-1,1,natom,ispin))
60 : ELSE
61 385756 : orb%uum(l,m,n,ispin) = czero
62 385756 : orb%ddm(l,m,n,ispin) = czero
63 : ENDIF
64 : ENDDO
65 : ENDDO
66 : ENDDO
67 : !
68 : ! --> Local Orbital contribution: u,lo part
69 : !
70 10276 : DO ilo = 1, atoms%nlo(n)
71 4628 : l = atoms%llo(ilo,n)
72 13932 : DO m = -l, l
73 9304 : lm = l* (l+1) + m
74 164970 : DO i = 1,ne
75 : orb%uulo(ilo,m,n,ispin) = orb%uulo(ilo,m,n,ispin) + we(i) * (&
76 : eigVecCoeffs%abcof(i,lm,0,natom,ispin)* CONJG(eigVecCoeffs%ccof(m,i,ilo,natom,ispin)) +&
77 151038 : eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%abcof(i,lm,0,natom,ispin)) )
78 : orb%dulo(ilo,m,n,ispin) = orb%dulo(ilo,m,n,ispin) + we(i) * (&
79 : eigVecCoeffs%abcof(i,lm,1,natom,ispin)* CONJG(eigVecCoeffs%ccof(m,i,ilo,natom,ispin)) +&
80 151038 : eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%abcof(i,lm,1,natom,ispin)) )
81 151038 : IF (m.NE.l) THEN
82 : orb%uulop(ilo,m,n,ispin) = orb%uulop(ilo,m,n,ispin) + we(i) *(&
83 : eigVecCoeffs%abcof(i,lm,0,natom,ispin)* CONJG(eigVecCoeffs%ccof(m+1,i,ilo,natom,ispin))+&
84 75888 : eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%abcof(i,lm+1,0,natom,ispin)))
85 : orb%dulop(ilo,m,n,ispin) = orb%dulop(ilo,m,n,ispin) + we(i) *(&
86 : eigVecCoeffs%abcof(i,lm,1,natom,ispin)* CONJG(eigVecCoeffs%ccof(m+1,i,ilo,natom,ispin))+&
87 75888 : eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%abcof(i,lm+1,1,natom,ispin)))
88 : ELSE
89 75150 : orb%uulop(ilo,m,n,ispin) = czero
90 75150 : orb%dulop(ilo,m,n,ispin) = czero
91 : ENDIF
92 160342 : IF (m.NE.-l) THEN
93 : orb%uulom(ilo,m,n,ispin) = orb%uulom(ilo,m,n,ispin) + we(i) *(&
94 : eigVecCoeffs%abcof(i,lm,0,natom,ispin)* CONJG(eigVecCoeffs%ccof(m-1,i,ilo,natom,ispin))+&
95 75888 : eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%abcof(i,lm-1,0,natom,ispin)))
96 : orb%dulom(ilo,m,n,ispin) = orb%dulom(ilo,m,n,ispin) + we(i) *(&
97 : eigVecCoeffs%abcof(i,lm,1,natom,ispin)* CONJG(eigVecCoeffs%ccof(m-1,i,ilo,natom,ispin))+&
98 75888 : eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%abcof(i,lm-1,1,natom,ispin)))
99 : ELSE
100 75150 : orb%uulom(ilo,m,n,ispin) = czero
101 75150 : orb%dulom(ilo,m,n,ispin) = czero
102 : ENDIF
103 : ENDDO ! sum over eigenstates (i)
104 : ENDDO ! loop over m
105 : !
106 : ! --> lo,lo' part
107 : !
108 16666 : DO ilop = 1, atoms%nlo(n)
109 13840 : IF (atoms%llo(ilop,n).EQ.l) THEN
110 13932 : DO m = -l, l
111 164970 : DO i = 1,ne
112 : orb%z(ilo,ilop,m,n,ispin) = orb%z(ilo,ilop,m,n,ispin) +&
113 151038 : we(i) * eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m,i,ilop,natom,ispin) )
114 151038 : IF (m.NE.l) THEN
115 : orb%p(ilo,ilop,m,n,ispin) = orb%p(ilo,ilop,m,n,ispin) +&
116 75888 : we(i) * eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m+1,i,ilop,natom,ispin) )
117 : ELSE
118 75150 : orb%p(ilo,ilop,m,n,ispin) = czero
119 : ENDIF
120 160342 : IF (m.NE.-l) THEN
121 : orb%m(ilo,ilop,m,n,ispin) = orb%m(ilo,ilop,m,n,ispin) +&
122 75888 : we(i) * eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m-1,i,ilop,natom,ispin) )
123 : ELSE
124 75150 : orb%m(ilo,ilop,m,n,ispin) = czero
125 : ENDIF
126 : ENDDO ! sum over eigenstates (i)
127 : ENDDO ! loop over m
128 : ENDIF
129 : ENDDO ! loop over lo's (ilop)
130 :
131 : ENDDO ! loop over lo's (ilo)
132 :
133 : ENDDO ! sum over equiv atoms (na)
134 : ENDDO ! loop over atom types (n)
135 :
136 1566 : RETURN
137 : END SUBROUTINE orbmom
138 : END MODULE m_orbmom
|
