Line data    Source code

       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             : MODULE m_rhomtlo
       8             :   !
       9             :   !***********************************************************************
      10             :   ! This subroutine is the equivalent of rhomt for the local orbital
      11             :   ! contributions to the charge.
      12             :   ! aclo,bclo,cclo are the equivalents of uu,ud,dd in rhomt
      13             :   ! p.kurz sept. 1996
      14             :   !***********************************************************************
      15             :   !
      16             : CONTAINS
      17           0 :   SUBROUTINE rhomtlo(atoms,ne,we,eigVecCoeffs,denCoeffs,ispin)
      18             : 
      19             :     USE m_types
      20             :     IMPLICIT NONE
      21             :     TYPE(t_atoms),        INTENT(IN)    :: atoms
      22             :     TYPE(t_eigVecCoeffs), INTENT(IN)    :: eigVecCoeffs
      23             :     TYPE(t_denCoeffs),    INTENT(INOUT) :: denCoeffs
      24             : 
      25             :     INTEGER, INTENT (IN) :: ne, ispin
      26             : 
      27             :     REAL,    INTENT (IN) :: we(:)!(nobd)
      28             : 
      29             :     INTEGER i,l,lm,lo,lop ,natom,nn,ntyp,m
      30             : 
      31           0 :     natom = 0
      32             :     !---> loop over atoms
      33           0 :     DO ntyp = 1,atoms%ntype
      34           0 :        DO nn = 1,atoms%neq(ntyp)
      35           0 :           natom = natom + 1
      36             :           !--->       loop over the local orbitals
      37           0 :           DO lo = 1,atoms%nlo(ntyp)
      38           0 :              l = atoms%llo(lo,ntyp)
      39             :              !--->       contribution of cross terms flapw - local orbitals
      40           0 :              DO m = -l,l
      41           0 :                 lm = l* (l+1) + m
      42           0 :                 DO i = 1,ne
      43             :                    denCoeffs%aclo(lo,ntyp,ispin) = denCoeffs%aclo(lo,ntyp,ispin) + we(i)*2*&
      44           0 :                         real(conjg(eigVecCoeffs%abcof(i,lm,0,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
      45             :                    denCoeffs%bclo(lo,ntyp,ispin) = denCoeffs%bclo(lo,ntyp,ispin) + we(i)*2*&
      46           0 :                         real(conjg(eigVecCoeffs%abcof(i,lm,1,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
      47             :                 END DO
      48             :              END DO
      49             :              !--->       contribution of local orbital - local orbital terms
      50             :              !--->       loop over lo'
      51           0 :              DO lop = 1,atoms%nlo(ntyp)
      52           0 :                 IF (atoms%llo(lop,ntyp).EQ.l) THEN
      53           0 :                    DO m = -l,l
      54           0 :                       DO i = 1,ne
      55             :                          denCoeffs%cclo(lop,lo,ntyp,ispin) = denCoeffs%cclo(lop,lo,ntyp,ispin) + we(i)*&
      56           0 :                               real(conjg(eigVecCoeffs%ccof(m,i,lop,natom,ispin))*eigVecCoeffs%ccof(m,i,lo,natom,ispin))
      57             :                       END DO
      58             :                    END DO
      59             :                 END IF
      60             :              END DO
      61             :           END DO
      62             :        END DO
      63             :     END DO
      64             : 
      65             : 
      66           0 :   END SUBROUTINE rhomtlo
      67             : END MODULE m_rhomtlo