orbmom.f90 7.12 KB
Newer Older
1
2
3
4
5
6
7
8
MODULE m_orbmom
  !     ***************************************************************
  !     perform the sum over m (for each l) and bands to set up the
  !     coefficient of spherical contribution to orbital moment.
  !     all quantities are in the local spin-frame
  !     ***************************************************************

CONTAINS
9
  SUBROUTINE orbmom(atoms,ne,we,ispin,eigVecCoeffs,orb)
10
11
12
13

    !USE m_types, ONLY : t_orb,t_orbl,t_orblo
    USE m_types
    IMPLICIT NONE
14
15
    TYPE(t_atoms),        INTENT(IN) :: atoms
    TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
16
17
    !     ..
    !     .. Scalar Arguments ..
18
    INTEGER, INTENT (IN) :: ne, ispin
19
20
21
    !     ..
    !     .. Array Arguments ..
    REAL,    INTENT (IN) :: we(:)!(nobd)
22
23
    TYPE (t_orb), INTENT (INOUT) :: orb

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
    !     .. Local Scalars ..
    INTEGER i,l,lm ,n,na,natom,ilo,ilop,m
    COMPLEX,PARAMETER:: czero= CMPLX(0.0,0.0)

    natom = 0
    DO n = 1,atoms%ntype
       DO na = 1,atoms%neq(n)
          natom = natom + 1

          DO  l = 0,atoms%lmax(n)
             !     -----> sum over m
             DO  m = -l,l
                lm = l* (l+1) + m
                !     -----> sum over occupied bands
                DO  i = 1,ne
                   ! coeff. for lz ->
40
41
42
43
                   orb%uu(l,m,n,ispin) = orb%uu(l,m,n,ispin) + we(i)*eigVecCoeffs%acof(i,lm,natom,ispin)*&
                                                               CONJG(eigVecCoeffs%acof(i,lm,natom,ispin))
                   orb%dd(l,m,n,ispin) = orb%dd(l,m,n,ispin) + we(i)*eigVecCoeffs%bcof(i,lm,natom,ispin)*&
                                                               CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin))
44
45
                   ! coeff. for l+ <M'|l+|M> with respect to M ->
                   IF (m.NE.l) THEN
46
47
48
49
                      orb%uup(l,m,n,ispin) = orb%uup(l,m,n,ispin) + we(i)*eigVecCoeffs%acof(i,lm,natom,ispin)*&
                                                                    CONJG(eigVecCoeffs%acof(i,lm+1,natom,ispin))
                      orb%ddp(l,m,n,ispin) = orb%ddp(l,m,n,ispin) + we(i)*eigVecCoeffs%bcof(i,lm,natom,ispin)*&
                                                                    CONJG(eigVecCoeffs%bcof(i,lm+1,natom,ispin))
50
                   ELSE
51
52
                      orb%uup(l,m,n,ispin) = czero
                      orb%ddp(l,m,n,ispin) = czero
53
54
55
                   ENDIF
                   ! coeff. for l- <M'|l-|M> with respect to M ->
                   IF (m.NE.-l) THEN
56
57
58
59
                      orb%uum(l,m,n,ispin) = orb%uum(l,m,n,ispin) + we(i)*eigVecCoeffs%acof(i,lm,natom,ispin)*&
                                                                    CONJG(eigVecCoeffs%acof(i,lm-1,natom,ispin))
                      orb%ddm(l,m,n,ispin) = orb%ddm(l,m,n,ispin) + we(i)*eigVecCoeffs%bcof(i,lm,natom,ispin)*&
                                                                    CONJG(eigVecCoeffs%bcof(i,lm-1,natom,ispin))
60
                   ELSE
61
62
                      orb%uum(l,m,n,ispin) = czero
                      orb%ddm(l,m,n,ispin) = czero
63
64
65
66
67
68
69
70
71
72
73
74
                   ENDIF
                ENDDO
             ENDDO
          ENDDO
          !
          ! --> Local Orbital contribution: u,lo part
          !
          DO ilo = 1, atoms%nlo(n)
             l = atoms%llo(ilo,n)
             DO m = -l, l
                lm = l* (l+1) + m
                DO i = 1,ne
75
                   orb%uulo(ilo,m,n,ispin) = orb%uulo(ilo,m,n,ispin) + we(i) * (&
76
77
                        eigVecCoeffs%acof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m,i,ilo,natom,ispin)) +&
                        eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%acof(i,lm,natom,ispin)) )
78
                   orb%dulo(ilo,m,n,ispin) = orb%dulo(ilo,m,n,ispin) + we(i) * (&
79
80
                        eigVecCoeffs%bcof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m,i,ilo,natom,ispin)) +&
                        eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin)) )
81
                   IF (m.NE.l) THEN
82
                      orb%uulop(ilo,m,n,ispin) = orb%uulop(ilo,m,n,ispin) + we(i) *(&
83
84
                           eigVecCoeffs%acof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m+1,i,ilo,natom,ispin))+&
                           eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%acof(i,lm+1,natom,ispin)))
85
                      orb%dulop(ilo,m,n,ispin) = orb%dulop(ilo,m,n,ispin) + we(i) *(&
86
87
                           eigVecCoeffs%bcof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m+1,i,ilo,natom,ispin))+&
                           eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%bcof(i,lm+1,natom,ispin)))
88
                   ELSE
89
90
                      orb%uulop(ilo,m,n,ispin) = czero
                      orb%dulop(ilo,m,n,ispin) = czero
91
92
                   ENDIF
                   IF (m.NE.-l) THEN
93
                      orb%uulom(ilo,m,n,ispin) = orb%uulom(ilo,m,n,ispin) + we(i) *(&
94
95
                           eigVecCoeffs%acof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m-1,i,ilo,natom,ispin))+&
                           eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%acof(i,lm-1,natom,ispin)))
96
                      orb%dulom(ilo,m,n,ispin) = orb%dulom(ilo,m,n,ispin) + we(i) *(&
97
98
                           eigVecCoeffs%bcof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m-1,i,ilo,natom,ispin))+&
                           eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%bcof(i,lm-1,natom,ispin)))
99
                   ELSE
100
101
                      orb%uulom(ilo,m,n,ispin) = czero
                      orb%dulom(ilo,m,n,ispin) = czero
102
103
104
105
106
107
108
109
110
111
                   ENDIF
                ENDDO  ! sum over eigenstates (i)
             ENDDO    ! loop over m
             !
             ! --> lo,lo' part           
             !
             DO ilop = 1, atoms%nlo(n)
                IF (atoms%llo(ilop,n).EQ.l) THEN
                   DO m = -l, l
                      DO i = 1,ne
112
                         orb%z(ilo,ilop,m,n,ispin) = orb%z(ilo,ilop,m,n,ispin) +&
113
                              we(i) *   eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m,i,ilop,natom,ispin) ) 
114
                         IF (m.NE.l) THEN
115
                            orb%p(ilo,ilop,m,n,ispin) = orb%p(ilo,ilop,m,n,ispin) +&
116
                                 we(i) *  eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m+1,i,ilop,natom,ispin) ) 
117
                         ELSE
118
                            orb%p(ilo,ilop,m,n,ispin) = czero
119
120
                         ENDIF
                         IF (m.NE.-l) THEN
121
                            orb%m(ilo,ilop,m,n,ispin) = orb%m(ilo,ilop,m,n,ispin) +&
122
                                 we(i) *  eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m-1,i,ilop,natom,ispin) )  
123
                         ELSE
124
                            orb%m(ilo,ilop,m,n,ispin) = czero
125
126
127
128
129
130
131
132
133
134
135
136
137
138
                         ENDIF
                      ENDDO  ! sum over eigenstates (i)
                   ENDDO    ! loop over m
                ENDIF
             ENDDO      ! loop over lo's (ilop)

          ENDDO      ! loop over lo's (ilo)

       ENDDO ! sum over equiv atoms (na)
    ENDDO    ! loop over atom types (n)

    RETURN
  END SUBROUTINE orbmom
END MODULE m_orbmom