orbmom.f90 6.18 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
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
  SUBROUTINE orbmom(atoms,ne,we,acof,bcof, ccof, orb,orbl,orblo)

    !USE m_types, ONLY : t_orb,t_orbl,t_orblo
    USE m_types
    IMPLICIT NONE
    TYPE(t_atoms),INTENT(IN)   :: atoms
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: ne
    !     ..
    !     .. 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)
Daniel Wortmann's avatar
Daniel Wortmann committed
24 25 26
    TYPE (t_orb),  INTENT (INOUT) :: orb(0:atoms%lmaxd,-atoms%lmaxd:atoms%lmaxd,atoms%ntype)
    TYPE (t_orbl), INTENT (INOUT) :: orbl(atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype)
    TYPE (t_orblo),INTENT (INOUT) :: orblo(atoms%nlod,atoms%nlod,-atoms%llod:atoms%llod,atoms%ntype)
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 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136
    !     ..
    !     .. 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 ->
                   orb(l,m,n)%uu = orb(l,m,n)%uu + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm,natom))
                   orb(l,m,n)%dd = orb(l,m,n)%dd + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm,natom))
                   ! coeff. for l+ <M'|l+|M> with respect to M ->
                   IF (m.NE.l) THEN
                      orb(l,m,n)%uup = orb(l,m,n)%uup + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm+1,natom))
                      orb(l,m,n)%ddp = orb(l,m,n)%ddp + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm+1,natom))
                   ELSE
                      orb(l,m,n)%uup = czero
                      orb(l,m,n)%ddp = czero
                   ENDIF
                   ! coeff. for l- <M'|l-|M> with respect to M ->
                   IF (m.NE.-l) THEN
                      orb(l,m,n)%uum = orb(l,m,n)%uum + we(i)*acof(i,lm,natom)* CONJG(acof(i,lm-1,natom))
                      orb(l,m,n)%ddm = orb(l,m,n)%ddm + we(i)*bcof(i,lm,natom)* CONJG(bcof(i,lm-1,natom))
                   ELSE
                      orb(l,m,n)%uum = czero
                      orb(l,m,n)%ddm = czero
                   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
                   orbl(ilo,m,n)%uulo = orbl(ilo,m,n)%uulo + we(i) * (&
                        acof(i,lm,natom)* CONJG(ccof(m,i,ilo,natom)) +&
                        ccof(m,i,ilo,natom)* CONJG(acof(i,lm,natom)) )
                   orbl(ilo,m,n)%dulo = orbl(ilo,m,n)%dulo + we(i) * (&
                        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
                      orbl(ilo,m,n)%uulop = orbl(ilo,m,n)%uulop + we(i) *(&
                           acof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(acof(i,lm+1,natom)))
                      orbl(ilo,m,n)%dulop = orbl(ilo,m,n)%dulop + we(i) *(&
                           bcof(i,lm,natom)* CONJG(ccof(m+1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(bcof(i,lm+1,natom)))
                   ELSE
                      orbl(ilo,m,n)%uulop = czero
                      orbl(ilo,m,n)%dulop = czero
                   ENDIF
                   IF (m.NE.-l) THEN
                      orbl(ilo,m,n)%uulom = orbl(ilo,m,n)%uulom + we(i) *(&
                           acof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(acof(i,lm-1,natom)))
                      orbl(ilo,m,n)%dulom = orbl(ilo,m,n)%dulom + we(i) *(&
                           bcof(i,lm,natom)* CONJG(ccof(m-1,i,ilo,natom))+&
                           ccof(m,i,ilo,natom)* CONJG(bcof(i,lm-1,natom)))
                   ELSE
                      orbl(ilo,m,n)%uulom = czero
                      orbl(ilo,m,n)%dulom = czero
                   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
                         orblo(ilo,ilop,m,n)%z = orblo(ilo,ilop,m,n)%z +&
                              we(i) *   ccof(m,i,ilo, natom) * CONJG( ccof(m,i,ilop,natom) ) 
                         IF (m.NE.l) THEN
                            orblo(ilo,ilop,m,n)%p = orblo(ilo,ilop,m,n)%p +&
                                 we(i) *  ccof(m,  i,ilo, natom) * CONJG( ccof(m+1,i,ilop,natom) ) 
                         ELSE
                            orblo(ilo,ilop,m,n)%p = czero
                         ENDIF
                         IF (m.NE.-l) THEN
                            orblo(ilo,ilop,m,n)%m = orblo(ilo,ilop,m,n)%m +&
                                 we(i) *  ccof(m,  i,ilo, natom) * CONJG( ccof(m-1,i,ilop,natom) )  
                         ELSE
                            orblo(ilo,ilop,m,n)%m = czero
                         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