rhomt21.f90 4.14 KB
Newer Older
1 2 3 4 5 6 7 8 9
MODULE m_rhomt21
  !     ***************************************************************
  !     perform the sum over m (for each l) and bands to set up the
  !     coefficient of spherical charge densities in subroutine 
  !     cdnval                                 
  !     for offdiagonal matrix-elements in case of noncollinear magnetism 
  !     FF
  !     ***************************************************************
CONTAINS
10 11 12 13
  SUBROUTINE rhomt21(atoms,we,ne,eigVecCoeffs,uu21,ud21,du21,dd21,uulo21,dulo21,ulou21,ulod21,uloulop21)

    USE m_types_setup
    USE m_types_cdnval
14 15

    IMPLICIT NONE
16 17 18

    TYPE(t_atoms),       INTENT(IN)    :: atoms
    TYPE(t_eigVecCoeffs),INTENT(IN)    :: eigVecCoeffs
19

20
    !     .. Scalar Arguments ..
21
    INTEGER,             INTENT(IN)    :: ne 
22

23
    !     .. Array Arguments ..
24
    REAL,                INTENT(IN)    :: we(:)!(nobd)
25 26 27 28
    COMPLEX,             INTENT(INOUT) :: uu21(0:atoms%lmaxd,atoms%ntype)
    COMPLEX,             INTENT(INOUT) :: ud21(0:atoms%lmaxd,atoms%ntype)
    COMPLEX,             INTENT(INOUT) :: du21(0:atoms%lmaxd,atoms%ntype)
    COMPLEX,             INTENT(INOUT) :: dd21(0:atoms%lmaxd,atoms%ntype)
29 30 31 32 33
    COMPLEX,             INTENT(INOUT) :: uulo21(atoms%nlod,atoms%ntype)
    COMPLEX,             INTENT(INOUT) :: dulo21(atoms%nlod,atoms%ntype)
    COMPLEX,             INTENT(INOUT) :: ulou21(atoms%nlod,atoms%ntype)
    COMPLEX,             INTENT(INOUT) :: ulod21(atoms%nlod,atoms%ntype)
    COMPLEX,             INTENT(INOUT) :: uloulop21(atoms%nlod,atoms%nlod,atoms%ntype)
34

35
    !     .. Local Scalars ..
36
    INTEGER i,l,lm,itype,na,natom,lo,lop,m
37 38 39 40 41 42 43 44 45 46 47 48
    natom = 0
    DO itype = 1,atoms%ntype
       DO na = 1,atoms%neq(itype)
          natom = natom + 1
          !
          !--->       normal u, du contribution
          !
          DO l = 0,atoms%lmax(itype)
             DO m = -l,l
                lm = l* (l+1) + m
                !--->           sum over occupied bands
                DO i = 1,ne
49 50 51 52
                   uu21(l,itype) = uu21(l,itype) + we(i)* CONJG(eigVecCoeffs%acof(i,lm,natom,2))*eigVecCoeffs%acof(i,lm,natom,1)
                   ud21(l,itype) = ud21(l,itype) + we(i)* CONJG(eigVecCoeffs%acof(i,lm,natom,2))*eigVecCoeffs%bcof(i,lm,natom,1)
                   du21(l,itype) = du21(l,itype) + we(i)* CONJG(eigVecCoeffs%bcof(i,lm,natom,2))*eigVecCoeffs%acof(i,lm,natom,1)
                   dd21(l,itype) = dd21(l,itype) + we(i)* CONJG(eigVecCoeffs%bcof(i,lm,natom,2))*eigVecCoeffs%bcof(i,lm,natom,1)
53 54 55 56 57 58 59 60 61 62 63 64
                ENDDO ! i = 1,ne
             ENDDO   ! m = -l,l
          ENDDO     ! l
          !
          !--->       loop over the local orbitals
          !
          DO lo = 1,atoms%nlo(itype)
             l = atoms%llo(lo,itype)
             !--->         contribution of cross terms flapw - local orbitals
             DO m = -l,l
                lm = l* (l+1) + m
                DO i = 1,ne
65 66 67 68
                   uulo21(lo,itype) = uulo21(lo,itype) + we(i)* CONJG(eigVecCoeffs%acof(i,lm,natom,2))*eigVecCoeffs%ccof(m,i,lo,natom,1)
                   dulo21(lo,itype) = dulo21(lo,itype) + we(i)* CONJG(eigVecCoeffs%bcof(i,lm,natom,2))*eigVecCoeffs%ccof(m,i,lo,natom,1)
                   ulou21(lo,itype) = ulou21(lo,itype) + we(i)* CONJG(eigVecCoeffs%acof(i,lm,natom,1))*eigVecCoeffs%ccof(m,i,lo,natom,2)
                   ulod21(lo,itype) = ulod21(lo,itype) + we(i)* CONJG(eigVecCoeffs%bcof(i,lm,natom,1))*eigVecCoeffs%ccof(m,i,lo,natom,2)
69 70 71 72 73 74 75 76
                ENDDO
             ENDDO
             !--->         contribution of local orbital - local orbital terms
             !--->         loop over lo'
             DO lop = 1,atoms%nlo(itype)
                IF (atoms%llo(lop,itype).EQ.l) THEN
                   DO m = -l,l
                      DO i = 1,ne
77 78
                         uloulop21(lop,lo,itype) = uloulop21(lop,lo,itype)+&
                                                   we(i)*CONJG(eigVecCoeffs%ccof(m,i,lop,natom,2))*eigVecCoeffs%ccof(m,i,lo, natom,1)
79 80 81 82 83 84 85 86 87 88 89
                      ENDDO ! i = 1,ne
                   ENDDO   ! m = -l,l
                ENDIF
             ENDDO     ! lop
          ENDDO       ! lo

       ENDDO          ! na
    ENDDO             ! itype

  END SUBROUTINE rhomt21
END MODULE m_rhomt21