orbmom.f90 6.14 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,acof,bcof, ccof, orb)
10 11 12 13 14 15 16

    !USE m_types, ONLY : t_orb,t_orbl,t_orblo
    USE m_types
    IMPLICIT NONE
    TYPE(t_atoms),INTENT(IN)   :: atoms
    !     ..
    !     .. Scalar Arguments ..
17
    INTEGER, INTENT (IN) :: ne, ispin
18 19
    !     ..
    !     .. Array Arguments ..
Daniel Wortmann's avatar
Daniel Wortmann committed
20 21 22
    COMPLEX, INTENT (IN) :: acof(:,0:,:) !(nobd,0:dimension%lmd,atoms%nat)
    COMPLEX, INTENT (IN) :: bcof(:,0:,:) !(nobd,0:dimension%lmd,atoms%nat)
    COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:)!(-atoms%llod:llod,nobd,atoms%nlod,atoms%nat)
23
    REAL,    INTENT (IN) :: we(:)!(nobd)
24 25
    TYPE (t_orb), INTENT (INOUT) :: orb

26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41
    !     .. 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 ->
42 43
                   orb%uu(l,m,n,ispin) = orb%uu(l,m,n,ispin) + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm,natom))
                   orb%dd(l,m,n,ispin) = orb%dd(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm,natom))
44 45
                   ! coeff. for l+ <M'|l+|M> with respect to M ->
                   IF (m.NE.l) THEN
46 47
                      orb%uup(l,m,n,ispin) = orb%uup(l,m,n,ispin) + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm+1,natom))
                      orb%ddp(l,m,n,ispin) = orb%ddp(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm+1,natom))
48
                   ELSE
49 50
                      orb%uup(l,m,n,ispin) = czero
                      orb%ddp(l,m,n,ispin) = czero
51 52 53
                   ENDIF
                   ! coeff. for l- <M'|l-|M> with respect to M ->
                   IF (m.NE.-l) THEN
54 55
                      orb%uum(l,m,n,ispin) = orb%uum(l,m,n,ispin) + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm-1,natom))
                      orb%ddm(l,m,n,ispin) = orb%ddm(l,m,n,ispin) + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm-1,natom))
56
                   ELSE
57 58
                      orb%uum(l,m,n,ispin) = czero
                      orb%ddm(l,m,n,ispin) = czero
59 60 61 62 63 64 65 66 67 68 69 70
                   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
71
                   orb%uulo(ilo,m,n,ispin) = orb%uulo(ilo,m,n,ispin) + we(i) * (&
72 73
                        acof(i,lm,natom)* CONJG(ccof(m,i,ilo,natom)) +&
                        ccof(m,i,ilo,natom)* CONJG(acof(i,lm,natom)) )
74
                   orb%dulo(ilo,m,n,ispin) = orb%dulo(ilo,m,n,ispin) + we(i) * (&
75 76 77
                        bcof(i,lm,natom)* CONJG(ccof(m,i,ilo,natom)) +&
                        ccof(m,i,ilo,natom)* CONJG(bcof(i,lm,natom)) )
                   IF (m.NE.l) THEN
78
                      orb%uulop(ilo,m,n,ispin) = orb%uulop(ilo,m,n,ispin) + we(i) *(&
79 80
                           acof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(acof(i,lm+1,natom)))
81
                      orb%dulop(ilo,m,n,ispin) = orb%dulop(ilo,m,n,ispin) + we(i) *(&
82 83 84
                           bcof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(bcof(i,lm+1,natom)))
                   ELSE
85 86
                      orb%uulop(ilo,m,n,ispin) = czero
                      orb%dulop(ilo,m,n,ispin) = czero
87 88
                   ENDIF
                   IF (m.NE.-l) THEN
89
                      orb%uulom(ilo,m,n,ispin) = orb%uulom(ilo,m,n,ispin) + we(i) *(&
90 91
                           acof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(acof(i,lm-1,natom)))
92
                      orb%dulom(ilo,m,n,ispin) = orb%dulom(ilo,m,n,ispin) + we(i) *(&
93 94 95
                           bcof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(bcof(i,lm-1,natom)))
                   ELSE
96 97
                      orb%uulom(ilo,m,n,ispin) = czero
                      orb%dulom(ilo,m,n,ispin) = czero
98 99 100 101 102 103 104 105 106 107
                   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
108
                         orb%z(ilo,ilop,m,n,ispin) = orb%z(ilo,ilop,m,n,ispin) +&
109 110
                              we(i) *   ccof(m,i,ilo, natom) * CONJG( ccof(m,i,ilop,natom) ) 
                         IF (m.NE.l) THEN
111
                            orb%p(ilo,ilop,m,n,ispin) = orb%p(ilo,ilop,m,n,ispin) +&
112 113
                                 we(i) *  ccof(m,  i,ilo, natom) * CONJG( ccof(m+1,i,ilop,natom) ) 
                         ELSE
114
                            orb%p(ilo,ilop,m,n,ispin) = czero
115 116
                         ENDIF
                         IF (m.NE.-l) THEN
117
                            orb%m(ilo,ilop,m,n,ispin) = orb%m(ilo,ilop,m,n,ispin) +&
118 119
                                 we(i) *  ccof(m,  i,ilo, natom) * CONJG( ccof(m-1,i,ilop,natom) )  
                         ELSE
120
                            orb%m(ilo,ilop,m,n,ispin) = czero
121 122 123 124 125 126 127 128 129 130 131 132 133 134
                         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