Commit 414af61e authored by Robin Hilgers's avatar Robin Hilgers

Merge branch 'develop' of https://iffgit.fz-juelich.de/fleur/fleur into develop

parents c0a8cc91 87c69915
......@@ -246,8 +246,8 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
IF (atoms%n_u.GT.0) CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,den%mmpMat(:,:,:,ispin))
IF (atoms%n_u.GT.0.AND.noco%l_mperp.AND.(ispin==jsp_end)) CALL n_mat21(atoms,sym,noccbd,denCoeffsOffdiag,&
we,eigVecCoeffs,angle,den%mmpMat(:,:,:,3))
IF (atoms%n_u.GT.0.AND.noco%l_mperp.AND.(ispin==jsp_end)) CALL n_mat21(atoms,sym,angle,noccbd,we,denCoeffsOffdiag,&
eigVecCoeffs,den%mmpMat(:,:,:,3))
IF (atoms%n_gf.GT.0) CALL bzIntegrationGF(atoms,sym,input,angle,ispin,noccbd,dosWeights,resWeights,dosBound,kpts%wtkpt(ikpt),&
eig,denCoeffsOffdiag,usdus,eigVecCoeffs,greensfCoeffs,ispin==jsp_end)
......
MODULE m_nmat21
MODULE m_nmat21
! ************************************************************
! This subroutine calculates the density matrix n^{s}_{m,m'}
! for a given atom 'n' and l-quantum number 'l'. The l's for
......@@ -6,137 +6,126 @@
! For details see Eq.(12) of Shick et al. PRB 60, 10765 (1999)
! Part of the LDA+U package G.B., Oct. 2000
! ************************************************************
CONTAINS
SUBROUTINE n_mat21(atoms,sym, ne,denCoeffsOffdiag,we,eigVecCoeffs,angle,n_mmp)
!
CONTAINS
SUBROUTINE n_mat21(atoms,sym,angle,ne,we,denCoeffsOffdiag,eigVecCoeffs,n_mmp)
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs),INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffsOffDiag), INTENT(IN) :: denCoeffsOffDiag
REAL, INTENT(IN) :: angle(sym%nop)
! ..
! .. Scalar Arguments ..
INTEGER, INTENT (IN) :: ne
! ..
! .. Array Arguments ..
REAL, INTENT (IN) :: we(:)!(dimension%neigd)
COMPLEX, INTENT (INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
USE m_types
USE m_constants
! ..
! .. Local Scalars ..
COMPLEX c_0,phase
INTEGER i,j,k,l,m,mp,n,it,is,isi,natom,n_ldau,lp
IMPLICIT NONE
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_eigVecCoeffs), INTENT(IN) :: eigVecCoeffs
TYPE(t_denCoeffsOffDiag), INTENT(IN) :: denCoeffsOffdiag
REAL, INTENT(IN) :: angle(:)
INTEGER, INTENT(IN) :: ne
REAL, INTENT(IN) :: we(:)!(input%neig)
COMPLEX, INTENT(INOUT) :: n_mmp(-lmaxU_const:,-lmaxU_const:,:)
INTEGER i,l,m,lp,mp,n,it,is,isi,natom
INTEGER ilo,ilop,ll1,nn,lmp,lm,i_u,natomTemp
REAL fac
! ..
! .. Local Arrays ..
COMPLEX n_tmp(-3:3,-3:3),nr_tmp(-3:3,-3:3),d_tmp(-3:3,-3:3)
COMPLEX n1_tmp(-3:3,-3:3)
! ..
! calculate n_mat:
!
COMPLEX c_0,phase
COMPLEX n_tmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const)
COMPLEX nr_tmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const)
COMPLEX d_tmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const)
COMPLEX n1_tmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const)
!
! calculate n_mat:
!
natom = 0
i_u = 1
DO n = 1,atoms%ntype
DO WHILE (i_u.LE.atoms%n_u)
IF (atoms%lda_u(i_u)%atomType.GT.n) EXIT
natomTemp = natom
n_tmp(:,:) = cmplx(0.0,0.0)
l = atoms%lda_u(i_u)%l
ll1 = (l+1)*l
DO nn = 1, atoms%neq(n)
natomTemp = natomTemp + 1
!
! prepare n_mat in local frame (in noco-calculations this depends
! also on alpha(n) and beta(n) )
!
DO m = -l,l
lm = ll1+m
DO mp = -l,l
lmp = ll1+mp
c_0 = cmplx(0.0,0.0)
DO i = 1,ne
c_0 = c_0 + we(i) * ( &
+ conjg(eigVecCoeffs%acof(i,lmp,natomTemp,2))*eigVecCoeffs%acof(i,lm,natomTemp,1) * denCoeffsOffdiag%uu21n(l,n) &
+ conjg(eigVecCoeffs%acof(i,lmp,natomTemp,2))*eigVecCoeffs%bcof(i,lm,natomTemp,1) * denCoeffsOffdiag%ud21n(l,n) &
+ conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,2))*eigVecCoeffs%acof(i,lm,natomTemp,1) * denCoeffsOffdiag%du21n(l,n) &
+ conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,2))*eigVecCoeffs%bcof(i,lm,natomTemp,1) * denCoeffsOffdiag%dd21n(l,n))
ENDDO
n_tmp(m,mp) = c_0
ENDDO
ENDDO
!
! add local orbital contribution (if there is one) (untested so far)
!
DO ilo = 1, atoms%nlo(n)
IF (atoms%llo(ilo,n).EQ.l) THEN
DO m = -l,l
lm = ll1+m
DO mp = -l,l
DO WHILE (i_u.LE.atoms%n_u)
IF (atoms%lda_u(i_u)%atomType.GT.n) EXIT
natomTemp = natom
n_tmp(:,:) = cmplx_0
l = atoms%lda_u(i_u)%l
ll1 = (l+1)*l
DO nn = 1, atoms%neq(n)
natomTemp = natomTemp + 1
!
! prepare n_mat in local frame (in noco-calculations this depends
! also on alpha(n) and beta(n) )
!
DO m = -l,l
lm = ll1+m
DO mp = -l,l
lmp = ll1+mp
c_0 = cmplx(0.0,0.0)
c_0 = cmplx_0
DO i = 1,ne
c_0 = c_0 + we(i) * ( &
conjg(eigVecCoeffs%acof(i,lmp,natomTemp,2))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,1) * denCoeffsOffdiag%uulo21n(l,n) + &
conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,2))*eigVecCoeffs%acof(i,lm,natomTemp,1) * denCoeffsOffdiag%ulou21n(l,n) + &
conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,2))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,1) * denCoeffsOffdiag%dulo21n(l,n) + &
conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,2))*eigVecCoeffs%bcof(i,lm,natomTemp,1) * denCoeffsOffdiag%ulod21n(l,n))
c_0 = c_0 + we(i) * ( &
conjg(eigVecCoeffs%acof(i,lmp,natomTemp,2))*eigVecCoeffs%acof(i,lm,natomTemp,1) * denCoeffsOffdiag%uu21n(l,n) &
+ conjg(eigVecCoeffs%acof(i,lmp,natomTemp,2))*eigVecCoeffs%bcof(i,lm,natomTemp,1) * denCoeffsOffdiag%ud21n(l,n) &
+ conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,2))*eigVecCoeffs%acof(i,lm,natomTemp,1) * denCoeffsOffdiag%du21n(l,n) &
+ conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,2))*eigVecCoeffs%bcof(i,lm,natomTemp,1) * denCoeffsOffdiag%dd21n(l,n))
ENDDO
DO ilop = 1, atoms%nlo(n)
IF (atoms%llo(ilop,n).EQ.l) THEN
DO i = 1,ne
c_0 = c_0 + we(i) * denCoeffsOffdiag%uloulop21n(ilo,ilop,n) *conjg(eigVecCoeffs%ccof(mp,i,ilop,natomTemp,2)) *eigVecCoeffs%ccof(m ,i,ilo ,natomTemp,1)
ENDDO
ENDIF
n_tmp(m,mp) = c_0
ENDDO
ENDDO
!
! add local orbital contribution (if there is one) (untested so far)
!
DO ilo = 1, atoms%nlo(n)
IF (atoms%llo(ilo,n).EQ.l) THEN
DO m = -l,l
lm = ll1+m
DO mp = -l,l
lmp = ll1+mp
c_0 = cmplx_0
DO i = 1,ne
c_0 = c_0 + we(i) * ( &
conjg(eigVecCoeffs%acof(i,lmp,natomTemp,2))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,1) * denCoeffsOffdiag%uulo21n(l,n) &
+ conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,2))*eigVecCoeffs%acof(i,lm,natomTemp,1) * denCoeffsOffdiag%ulou21n(l,n) &
+ conjg(eigVecCoeffs%bcof(i,lmp,natomTemp,2))*eigVecCoeffs%ccof(m,i,ilo,natomTemp,1) * denCoeffsOffdiag%dulo21n(l,n) &
+ conjg(eigVecCoeffs%ccof(mp,i,ilo,natomTemp,2))*eigVecCoeffs%bcof(i,lm,natomTemp,1) * denCoeffsOffdiag%ulod21n(l,n))
ENDDO
DO ilop = 1, atoms%nlo(n)
IF (atoms%llo(ilop,n).EQ.l) THEN
DO i = 1,ne
c_0 = c_0 + we(i) * denCoeffsOffdiag%uloulop21n(ilo,ilop,n) *conjg(eigVecCoeffs%ccof(mp,i,ilop,natomTemp,2)) *eigVecCoeffs%ccof(m ,i,ilo ,natomTemp,1)
ENDDO
ENDIF
ENDDO
n_tmp(m,mp) = n_tmp(m,mp) + c_0
ENDDO
ENDDO
n_tmp(m,mp) = n_tmp(m,mp) + c_0
ENDDO
ENDDO
ENDIF
ENDDO
!
! n_mmp should be rotated by D_mm' ; compare force_a21
!
DO it = 1, sym%invarind(natomTemp)
ENDIF
ENDDO
!
! n_mmp should be rotated by D_mm' ; compare force_a21
!
fac = 1.0 / ( sym%invarind(natomTemp) * atoms%neq(n) )
is = sym%invarop(natomTemp,it)
isi = sym%invtab(is)
d_tmp(:,:) = cmplx(0.0,0.0)
DO m = -l,l
DO mp = -l,l
d_tmp(m,mp) = sym%d_wgn(m,mp,l,isi)
ENDDO
ENDDO
nr_tmp = matmul( transpose( conjg(d_tmp) ) , n_tmp)
n1_tmp = matmul( nr_tmp, d_tmp )
phase = exp((0.0,1.0)*angle(isi))
DO m = -l,l
DO mp = -l,l
n_mmp(m,mp,i_u) = n_mmp(m,mp,i_u) + conjg(n1_tmp(m,mp)) *fac*phase
ENDDO
ENDDO
DO it = 1, sym%invarind(natomTemp)
ENDDO
fac = 1.0 / ( sym%invarind(natomTemp) * atoms%neq(n) )
is = sym%invarop(natomTemp,it)
isi = sym%invtab(is)
d_tmp(:,:) = cmplx_0
DO m = -l,l
DO mp = -l,l
d_tmp(m,mp) = sym%d_wgn(m,mp,l,isi)
ENDDO
ENDDO
nr_tmp = matmul( transpose( conjg(d_tmp) ) , n_tmp)
n1_tmp = matmul( nr_tmp, d_tmp )
phase = exp(ImagUnit*angle(isi))
DO m = -l,l
DO mp = -l,l
n_mmp(m,mp,i_u) = n_mmp(m,mp,i_u) + conjg(n1_tmp(m,mp)) * fac * phase
ENDDO
ENDDO
ENDDO
ENDDO ! sum over equivalent
i_u = i_u +1
ENDDO
natom = natom + atoms%neq(n)
ENDDO ! sum over equivalent
i_u = i_u +1
ENDDO
natom = natom + atoms%neq(n)
ENDDO ! loop over atom types
! do m=-l,l
! write(*,'(14f12.6)') (n_mmp21(m,mp,1),mp=-l,l)
! enddo
RETURN
END SUBROUTINE n_mat21
END MODULE m_nmat21
END SUBROUTINE n_mat21
END MODULE m_nmat21
......@@ -41,10 +41,10 @@ CONTAINS
sym%nsym = 2*sym%nop
END IF
!Generated wigner symbols for LDA+U
!Generated wigner symbols for LDA+U (includes DFT+HubbardI)
IF (ALLOCATED(sym%d_wgn)) DEALLOCATE(sym%d_wgn)
ALLOCATE(sym%d_wgn(-3:3,-3:3,3,sym%nop))
IF (atoms%n_u.GT.0) THEN
IF (atoms%n_u+atoms%n_hia.GT.0) THEN
CALL d_wigner(sym%nop,sym%mrot,cell%bmat,3,sym%d_wgn)
END IF
......
......@@ -432,7 +432,6 @@ C If the word TETCON5 appears you have failed the < 1.0D-5 test.
C
if ( abs(vt).gt.eps1 ) THEN
write(iofile,'('' tetcon5 '')')
CALL juDFT_error("")
endif
RETURN
END SUBROUTINE tetcon
......
......@@ -185,7 +185,8 @@ CONTAINS
!Collect some usage info
CALL add_usage_data("A-Types",atoms%ntype)
CALL add_usage_data("Atoms",atoms%nat)
CALL add_usage_data("Real",sym%invs.AND..NOT.noco%l_noco)
CALL add_usage_data("Real",sym%invs.AND..NOT.noco%l_noco&
.AND..NOT.(noco%l_soc.AND.atoms%n_u+atoms%n_hia.GT.0))
CALL add_usage_data("Spins",input%jspins)
CALL add_usage_data("Noco",noco%l_noco)
CALL add_usage_data("SOC",noco%l_soc)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment