rhomt21.f90 3.69 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
  SUBROUTINE rhomt21(atoms, we,ne,acof,bcof, ccof,denCoeffsOffdiag)
11 12 13 14 15 16 17 18 19 20 21 22 23

    USE m_types
    IMPLICIT NONE
    TYPE(t_atoms),INTENT(IN)   :: atoms
    !     ..
    !     .. Scalar Arguments ..
    INTEGER, INTENT (IN) :: ne 
    !     ..
    !     .. Array Arguments ..
    COMPLEX, INTENT (IN) :: acof(:,0:,:,:)!(nobd,0:lmaxd* (lmaxd+2),natd,jspd)
    COMPLEX, INTENT (IN) :: bcof(:,0:,:,:)
    COMPLEX, INTENT (IN) :: ccof(-atoms%llod:,:,:,:,:) !(-llod:llod,nobd,nlod,natd,jspd)
    REAL,    INTENT (IN) :: we(:)!(nobd)
24
    TYPE (t_denCoeffsOffdiag), INTENT (INOUT) :: denCoeffsOffdiag
25 26 27 28 29 30 31 32 33 34 35 36 37 38 39
    !     ..
    !     .. Local Scalars ..
    INTEGER   i,l,lm ,itype,na,natom,lo,lop,m
    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
40 41 42 43
                   denCoeffsOffdiag%uu21(l,itype) = denCoeffsOffdiag%uu21(l,itype) + we(i)* CONJG(acof(i,lm,natom,2))*acof(i,lm,natom,1)
                   denCoeffsOffdiag%ud21(l,itype) = denCoeffsOffdiag%ud21(l,itype) + we(i)* CONJG(acof(i,lm,natom,2))*bcof(i,lm,natom,1)
                   denCoeffsOffdiag%du21(l,itype) = denCoeffsOffdiag%du21(l,itype) + we(i)* CONJG(bcof(i,lm,natom,2))*acof(i,lm,natom,1)
                   denCoeffsOffdiag%dd21(l,itype) = denCoeffsOffdiag%dd21(l,itype) + we(i)* CONJG(bcof(i,lm,natom,2))*bcof(i,lm,natom,1)
44 45 46 47 48 49 50 51 52 53 54 55
                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
56 57 58 59
                   denCoeffsOffdiag%uulo21(lo,itype) = denCoeffsOffdiag%uulo21(lo,itype) + we(i)* CONJG(acof(i,lm,natom,2))*ccof(m,i,lo,natom,1)
                   denCoeffsOffdiag%dulo21(lo,itype) = denCoeffsOffdiag%dulo21(lo,itype) + we(i)* CONJG(bcof(i,lm,natom,2))*ccof(m,i,lo,natom,1)
                   denCoeffsOffdiag%ulou21(lo,itype) = denCoeffsOffdiag%ulou21(lo,itype) + we(i)* CONJG(acof(i,lm,natom,1))*ccof(m,i,lo,natom,2)
                   denCoeffsOffdiag%ulod21(lo,itype) = denCoeffsOffdiag%ulod21(lo,itype) + we(i)* CONJG(bcof(i,lm,natom,1))*ccof(m,i,lo,natom,2)
60 61 62 63 64 65 66 67
                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
68
                         denCoeffsOffdiag%uloulop21(lop,lo,itype) = denCoeffsOffdiag%uloulop21(lop,lo,itype)+&
69 70 71 72 73 74 75 76 77 78 79 80
                              we(i)*CONJG(ccof(m,i,lop,natom,2))*ccof(m,i,lo, natom,1)
                      ENDDO ! i = 1,ne
                   ENDDO   ! m = -l,l
                ENDIF
             ENDDO     ! lop
          ENDDO       ! lo

       ENDDO          ! na
    ENDDO             ! itype

  END SUBROUTINE rhomt21
END MODULE m_rhomt21