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
|