LCOV - code coverage report
Current view: top level - orbdep - orbmom.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 50 50 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          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         556 :   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         556 :     natom = 0
      29        1664 :     DO n = 1,atoms%ntype
      30        2776 :        DO na = 1,atoms%neq(n)
      31        1112 :           natom = natom + 1
      32             : 
      33       11128 :           DO  l = 0,atoms%lmax(n)
      34             :              !     -----> sum over m
      35      101488 :              DO  m = -l,l
      36       90360 :                 lm = l* (l+1) + m
      37             :                 !     -----> sum over occupied bands
      38     1089800 :                 DO  i = 1,ne
      39             :                    ! coeff. for lz ->
      40             :                    orb%uu(l,m,n,ispin) = orb%uu(l,m,n,ispin) + we(i)*eigVecCoeffs%acof(i,lm,natom,ispin)*&
      41      989424 :                                                                CONJG(eigVecCoeffs%acof(i,lm,natom,ispin))
      42             :                    orb%dd(l,m,n,ispin) = orb%dd(l,m,n,ispin) + we(i)*eigVecCoeffs%bcof(i,lm,natom,ispin)*&
      43      989424 :                                                                CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin))
      44             :                    ! coeff. for l+ <M'|l+|M> with respect to M ->
      45      989424 :                    IF (m.NE.l) THEN
      46             :                       orb%uup(l,m,n,ispin) = orb%uup(l,m,n,ispin) + we(i)*eigVecCoeffs%acof(i,lm,natom,ispin)*&
      47      879804 :                                                                     CONJG(eigVecCoeffs%acof(i,lm+1,natom,ispin))
      48             :                       orb%ddp(l,m,n,ispin) = orb%ddp(l,m,n,ispin) + we(i)*eigVecCoeffs%bcof(i,lm,natom,ispin)*&
      49      879804 :                                                                     CONJG(eigVecCoeffs%bcof(i,lm+1,natom,ispin))
      50             :                    ELSE
      51      109620 :                       orb%uup(l,m,n,ispin) = czero
      52      109620 :                       orb%ddp(l,m,n,ispin) = czero
      53             :                    ENDIF
      54             :                    ! coeff. for l- <M'|l-|M> with respect to M ->
      55     1079784 :                    IF (m.NE.-l) THEN
      56             :                       orb%uum(l,m,n,ispin) = orb%uum(l,m,n,ispin) + we(i)*eigVecCoeffs%acof(i,lm,natom,ispin)*&
      57      879804 :                                                                     CONJG(eigVecCoeffs%acof(i,lm-1,natom,ispin))
      58             :                       orb%ddm(l,m,n,ispin) = orb%ddm(l,m,n,ispin) + we(i)*eigVecCoeffs%bcof(i,lm,natom,ispin)*&
      59      879804 :                                                                     CONJG(eigVecCoeffs%bcof(i,lm-1,natom,ispin))
      60             :                    ELSE
      61      109620 :                       orb%uum(l,m,n,ispin) = czero
      62      109620 :                       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        2232 :           DO ilo = 1, atoms%nlo(n)
      71          12 :              l = atoms%llo(ilo,n)
      72          56 :              DO m = -l, l
      73          44 :                 lm = l* (l+1) + m
      74        1166 :                 DO i = 1,ne
      75             :                    orb%uulo(ilo,m,n,ispin) = orb%uulo(ilo,m,n,ispin) + we(i) * (&
      76             :                         eigVecCoeffs%acof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m,i,ilo,natom,ispin)) +&
      77        1110 :                         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             :                         eigVecCoeffs%bcof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m,i,ilo,natom,ispin)) +&
      80        1110 :                         eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%bcof(i,lm,natom,ispin)) )
      81        1110 :                    IF (m.NE.l) THEN
      82             :                       orb%uulop(ilo,m,n,ispin) = orb%uulop(ilo,m,n,ispin) + we(i) *(&
      83             :                            eigVecCoeffs%acof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m+1,i,ilo,natom,ispin))+&
      84         824 :                            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             :                            eigVecCoeffs%bcof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m+1,i,ilo,natom,ispin))+&
      87         824 :                            eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%bcof(i,lm+1,natom,ispin)))
      88             :                    ELSE
      89         286 :                       orb%uulop(ilo,m,n,ispin) = czero
      90         286 :                       orb%dulop(ilo,m,n,ispin) = czero
      91             :                    ENDIF
      92        1154 :                    IF (m.NE.-l) THEN
      93             :                       orb%uulom(ilo,m,n,ispin) = orb%uulom(ilo,m,n,ispin) + we(i) *(&
      94             :                            eigVecCoeffs%acof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m-1,i,ilo,natom,ispin))+&
      95         824 :                            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             :                            eigVecCoeffs%bcof(i,lm,natom,ispin)* CONJG(eigVecCoeffs%ccof(m-1,i,ilo,natom,ispin))+&
      98         824 :                            eigVecCoeffs%ccof(m,i,ilo,natom,ispin)* CONJG(eigVecCoeffs%bcof(i,lm-1,natom,ispin)))
      99             :                    ELSE
     100         286 :                       orb%uulom(ilo,m,n,ispin) = czero
     101         286 :                       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        1136 :              DO ilop = 1, atoms%nlo(n)
     109          24 :                 IF (atoms%llo(ilop,n).EQ.l) THEN
     110         100 :                    DO m = -l, l
     111        1166 :                       DO i = 1,ne
     112             :                          orb%z(ilo,ilop,m,n,ispin) = orb%z(ilo,ilop,m,n,ispin) +&
     113        1110 :                               we(i) *   eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m,i,ilop,natom,ispin) ) 
     114        1110 :                          IF (m.NE.l) THEN
     115             :                             orb%p(ilo,ilop,m,n,ispin) = orb%p(ilo,ilop,m,n,ispin) +&
     116         824 :                                  we(i) *  eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m+1,i,ilop,natom,ispin) ) 
     117             :                          ELSE
     118         286 :                             orb%p(ilo,ilop,m,n,ispin) = czero
     119             :                          ENDIF
     120        1154 :                          IF (m.NE.-l) THEN
     121             :                             orb%m(ilo,ilop,m,n,ispin) = orb%m(ilo,ilop,m,n,ispin) +&
     122         824 :                                  we(i) *  eigVecCoeffs%ccof(m,i,ilo,natom,ispin) * CONJG( eigVecCoeffs%ccof(m-1,i,ilop,natom,ispin) )  
     123             :                          ELSE
     124         286 :                             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         556 :     RETURN
     137             :   END SUBROUTINE orbmom
     138             : END MODULE m_orbmom

Generated by: LCOV version 1.13