rhomtlo.f90 2.64 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------

7 8 9 10 11 12 13 14 15 16
MODULE m_rhomtlo
  !
  !***********************************************************************
  ! This subroutine is the equivalent of rhomt for the local orbital
  ! contributions to the charge.
  ! aclo,bclo,cclo are the equivalents of uu,ud,dd in rhomt
  ! p.kurz sept. 1996
  !***********************************************************************
  !
CONTAINS
17
  SUBROUTINE rhomtlo(atoms,ne,we,eigVecCoeffs,denCoeffs,ispin)
18 19 20

    USE m_types
    IMPLICIT NONE
21 22 23
    TYPE(t_atoms),        INTENT(IN)    :: atoms
    TYPE(t_eigVecCoeffs), INTENT(IN)    :: eigVecCoeffs
    TYPE(t_denCoeffs),    INTENT(INOUT) :: denCoeffs
24 25 26

    INTEGER, INTENT (IN) :: ne, ispin

27
    REAL,    INTENT (IN) :: we(:)!(nobd)
28

29 30 31 32 33 34 35 36 37 38 39 40 41 42
    INTEGER i,l,lm,lo,lop ,natom,nn,ntyp,m

    natom = 0
    !---> loop over atoms
    DO ntyp = 1,atoms%ntype
       DO nn = 1,atoms%neq(ntyp)
          natom = natom + 1
          !--->       loop over the local orbitals
          DO lo = 1,atoms%nlo(ntyp)
             l = atoms%llo(lo,ntyp)
             !--->       contribution of cross terms flapw - local orbitals
             DO m = -l,l
                lm = l* (l+1) + m
                DO i = 1,ne
43
                   denCoeffs%aclo(lo,ntyp,ispin) = denCoeffs%aclo(lo,ntyp,ispin) + we(i)*2*&
44
                        real(conjg(eigVecCoeffs%acof(i,lm,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
45
                   denCoeffs%bclo(lo,ntyp,ispin) = denCoeffs%bclo(lo,ntyp,ispin) + we(i)*2*&
46
                        real(conjg(eigVecCoeffs%bcof(i,lm,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
47 48 49 50 51 52 53 54
                END DO
             END DO
             !--->       contribution of local orbital - local orbital terms
             !--->       loop over lo'
             DO lop = 1,atoms%nlo(ntyp)
                IF (atoms%llo(lop,ntyp).EQ.l) THEN
                   DO m = -l,l
                      DO i = 1,ne
55
                         denCoeffs%cclo(lop,lo,ntyp,ispin) = denCoeffs%cclo(lop,lo,ntyp,ispin) + we(i)*&
56
                              real(conjg(eigVecCoeffs%ccof(m,i,lop,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
57 58 59 60 61 62 63 64 65 66 67
                      END DO
                   END DO
                END IF
             END DO
          END DO
       END DO
    END DO


  END SUBROUTINE rhomtlo
END MODULE m_rhomtlo