rhomtlo.f90 2.85 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
17
18
19
20
21
22
23
24
25
26
27
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
  SUBROUTINE rhomtlo(atoms, ne,we,acof,bcof,ccof, aclo,bclo,cclo)

    USE m_types
    IMPLICIT NONE
    TYPE(t_atoms),INTENT(IN)   :: atoms
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: ne 
    !     ..
    !     .. Array Arguments ..
    REAL,    INTENT (IN) :: we(:)!(nobd)
Daniel Wortmann's avatar
Daniel Wortmann committed
28
29
30
31
32
    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)
    REAL,    INTENT (INOUT):: aclo(atoms%nlod,atoms%ntype),bclo(atoms%nlod,atoms%ntype)
    REAL,    INTENT (INOUT):: cclo(atoms%nlod,atoms%nlod,atoms%ntype)
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
    !     ..
    !     .. Local Scalars ..
    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
                   aclo(lo,ntyp) = aclo(lo,ntyp) + we(i)*2*&
                        real(conjg(acof(i,lm,natom))*ccof(m,i,lo,natom))
                   bclo(lo,ntyp) = bclo(lo,ntyp) + we(i)*2*&
                        real(conjg(bcof(i,lm,natom))*ccof(m,i,lo,natom))
                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
                         cclo(lop,lo,ntyp) = cclo(lop,lo,ntyp) + we(i)*&
                              real(conjg(ccof(m,i,lop,natom))*ccof(m,i,lo ,natom))
                      END DO
                   END DO
                END IF
             END DO
          END DO
       END DO
    END DO


  END SUBROUTINE rhomtlo
END MODULE m_rhomtlo