Commit 2ec00b4a authored by Henning Janssen's avatar Henning Janssen

Added off-diagonal DFT+U contributions to several more routines

parent 04fc83d6
MODULE m_denmat_dist
CONTAINS
SUBROUTINE n_mmp_dist(n_mmp_in,n_mmp_out,natoms,results,jspins)
SUBROUTINE n_mmp_dist(n_mmp_in,n_mmp_out,natoms,results,input)
USE m_types
USE m_constants
......@@ -10,7 +10,7 @@ MODULE m_denmat_dist
COMPLEX, INTENT(IN) :: n_mmp_in(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,natoms,jspins)
COMPLEX, INTENT(IN) :: n_mmp_out(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,natoms,jspins)
TYPE(t_results), INTENT(INOUT) :: results
INTEGER, INTENT(IN) :: jspins
TYPE(t_input), INTENT(IN) :: input
INTEGER ispin,i_at,j,k
REAL n_in,n_out
......@@ -19,14 +19,14 @@ MODULE m_denmat_dist
n_out = 0.0
n_in = 0.0
results%last_mmpMatdistance = 0.0
DO ispin = 1, jspins
DO ispin = 1, MERGE(3,input%jspins,input%l_gfmperp)
DO i_at = 1, natoms
DO j = -3,3
DO k = -3,3
IF((ABS(n_mmp_out(k,j,i_at,ispin) - n_mmp_in(k,j,i_at,ispin))).GT.results%last_mmpMatdistance) THEN
results%last_mmpMatdistance = ABS(n_mmp_out(k,j,i_at,ispin) - n_mmp_in(k,j,i_at,ispin))
ENDIF
IF(j.EQ.k) THEN
IF(j.EQ.k.AND.ispin<3) THEN
n_out = n_out + REAL(n_mmp_out(k,j,i_at,ispin))
n_in = n_in + REAL(n_mmp_in(k,j,i_at,ispin))
ENDIF
......
......@@ -4,7 +4,7 @@ MODULE m_hubbard1_setup
IMPLICIT NONE
LOGICAL, PARAMETER :: l_setupdebug = .FALSE. !Enable/Disable Debug outputs like dependency of occupation on chemical potential shift
LOGICAL, PARAMETER :: l_setupdebug = .TRUE. !Enable/Disable Debug outputs like dependency of occupation on chemical potential shift
CHARACTER(len=30), PARAMETER :: main_folder = "Hubbard1"
......@@ -18,6 +18,7 @@ MODULE m_hubbard1_setup
USE m_uj2f
USE m_umtx
USE m_vmmp
USE m_vmmp21
USE m_nmat_rot
USE m_mudc
USE m_denmat_dist
......@@ -51,7 +52,7 @@ MODULE m_hubbard1_setup
INTEGER i_hia,nType,l,n_occ,ispin,m,iz,k,j,i_exc,i
INTEGER io_error,ierr
INTEGER indStart,indEnd
REAL mu_dc,e_lda_hia,exc
REAL mu_dc,e_lda_hia,exc,e_off
CHARACTER(len=300) :: cwd,path,folder,xPath
CHARACTER(len=8) :: l_type*2,l_form*9
......@@ -106,6 +107,12 @@ MODULE m_hubbard1_setup
CALL v_mmp(sym,atoms,atoms%lda_u(indStart:indEnd),atoms%n_hia,input%jspins,input%l_dftspinpol,n_mmp,&
u,f0,f2,pot%mmpMat(:,:,indStart:indEnd,:),e_lda_hia)
IF(noco%l_mperp) THEN
IF(ANY(atoms%lda_u(1:atoms%n_u)%phi.NE.0.0).OR.ANY(atoms%lda_u(1:atoms%n_u)%theta.NE.0.0)) CALL juDFT_error("vmmp21+Rot not implemented", calledby="u_setup")
CALL v_mmp_21(atoms%lda_u(indStart:indEnd),atoms%n_u,den%mmpMat(:,:,indStart:indEnd,3),u,f0,f2,pot%mmpMat(:,:,indStart:indEnd,3),e_off)
e_lda_hia = e_lda_hia + e_off
ENDIF
IF(hub1%l_runthisiter.AND.(ANY(gdft%gmmpMat(:,:,:,:,:,:).NE.0.0)).AND.mpi%irank.EQ.0) THEN
!The onsite green's function was calculated but the solver
!was not yet run
......@@ -282,7 +289,7 @@ MODULE m_hubbard1_setup
! Calculate the distance and update the density matrix
!----------------------------------------------------------------------
CALL n_mmp_dist(den%mmpMat(:,:,indStart:indEnd,:),mmpMat,atoms%n_hia,results,input%jspins)
den%mmpMat(:,:,indStart:indEnd,:) = mmpMat(:,:,:,1:input%jspins) !For now LDA+U in FLEUR ignores spin offdiagonal elements
den%mmpMat(:,:,indStart:indEnd,:) = mmpMat(:,:,:,1:MERGE(3,input%jspins,noco%l_mperp)) !For now LDA+U in FLEUR ignores spin offdiagonal elements
!----------------------------------------------------------------------
! Calculate DFT+U potential correction
!----------------------------------------------------------------------
......@@ -292,6 +299,12 @@ MODULE m_hubbard1_setup
CALL nmat_rot(atoms%lda_u(indStart:indEnd)%phi,atoms%lda_u(indStart:indEnd)%theta,zero,3,atoms%n_hia,input%jspins,atoms%lda_u(indStart:indEnd)%l,n_mmp)
CALL v_mmp(sym,atoms,atoms%lda_u(indStart:indEnd),atoms%n_hia,input%jspins,input%l_dftspinpol,n_mmp,&
u,f0,f2,pot%mmpMat(:,:,indStart:indEnd,:), e_lda_hia)
IF(noco%l_mperp) THEN
IF(ANY(atoms%lda_u(1:atoms%n_u)%phi.NE.0.0).OR.ANY(atoms%lda_u(1:atoms%n_u)%theta.NE.0.0)) CALL juDFT_error("vmmp21+Rot not implemented", calledby="u_setup")
CALL v_mmp_21(atoms%lda_u(indStart:indEnd),atoms%n_u,den%mmpMat(:,:,indStart:indEnd,3),u,f0,f2,pot%mmpMat(:,:,indStart:indEnd,3),e_off)
e_lda_hia = e_lda_hia + e_off
ENDIF
results%e_ldau = MERGE(results%e_ldau,0.0,atoms%n_u>0) + e_lda_hia
ENDIF
ELSE
......
......@@ -78,6 +78,7 @@ CONTAINS
!spin off-diagonal elements (no rotation yet)
IF(noco%l_mperp) THEN
IF(ANY(atoms%lda_u(1:atoms%n_u)%phi.NE.0.0).OR.ANY(atoms%lda_u(1:atoms%n_u)%theta.NE.0.0)) CALL juDFT_error("vmmp21+Rot not implemented", calledby="u_setup")
CALL v_mmp_21(atoms%lda_u(1:atoms%n_u),atoms%n_u,inDen%mmpMat(:,:,1:atoms%n_u,3),u,f0,f2,pot%mmpMat(:,:,1:atoms%n_u,3),e_off)
results%e_ldau = results%e_ldau + e_off
ENDIF
......
......@@ -75,7 +75,7 @@ contains
IF (atoms%n_u>0) THEN
l_densitymatrix=.NOT.input%ldaulinmix
IF (mpi%irank==0) CALL u_mix(input,atoms,inDen%mmpMat,outDen%mmpMat)
IF (mpi%irank==0) CALL u_mix(input,atoms,noco,inDen%mmpMat,outDen%mmpMat)
IF (ALL(inDen%mmpMat(:,:,1:atoms%n_u,:)==0.0)) THEN
l_densitymatrix=.FALSE.
inDen%mmpMat(:,:,1:atoms%n_u,:)=outDen%mmpMat(:,:,1:atoms%n_u,:)
......
......@@ -12,7 +12,7 @@ MODULE m_umix
! --------------------------------------------------------
! Extension to multiple U per atom type by G.M. 2017
CONTAINS
SUBROUTINE u_mix(input,atoms,n_mmp_in,n_mmp_out)
SUBROUTINE u_mix(input,atoms,noco,n_mmp_in,n_mmp_out)
USE m_types
USE m_cdn_io
......@@ -24,25 +24,26 @@ CONTAINS
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_atoms),INTENT(IN) :: atoms
COMPLEX, INTENT (INOUT) :: n_mmp_out(-3:3,-3:3,atoms%n_u,input%jspins)
COMPLEX, INTENT (INOUT) :: n_mmp_in (-3:3,-3:3,atoms%n_u,input%jspins)
TYPE(t_noco),INTENT(IN) :: noco
COMPLEX, INTENT (INOUT) :: n_mmp_out(-3:3,-3:3,atoms%n_u,MERGE(3,input%jspins,noco%l_mperp))
COMPLEX, INTENT (INOUT) :: n_mmp_in (-3:3,-3:3,atoms%n_u,MERGE(3,input%jspins,noco%l_mperp))
!
! ... Locals ...
INTEGER j,k,iofl,l,itype,ios,i_u,jsp
REAL alpha,spinf,gam,del,sum1,sum2,mix_u, uParam, jParam
REAL alpha,spinf,gam,del,sum1,sum2,sum3,mix_u, uParam, jParam
REAL zero(atoms%n_u)
CHARACTER(LEN=20) :: attributes(6)
COMPLEX,ALLOCATABLE :: n_mmp(:,:,:,:)
!
! check for possible rotation of n_mmp
!
zero=0.0
CALL nmat_rot(zero,-atoms%lda_u%theta,-atoms%lda_u%phi,3,atoms%n_u,input%jspins,atoms%lda_u%l,n_mmp_out)
!zero=0.0
!CALL nmat_rot(zero,-atoms%lda_u%theta,-atoms%lda_u%phi,3,atoms%n_u,input%jspins,atoms%lda_u%l,n_mmp_out)
! Write out n_mmp_out to out.xml file
CALL openXMLElementNoAttributes('ldaUDensityMatrix')
DO jsp = 1, input%jspins
DO jsp = 1, MERGE(3,input%jspins,noco%l_mperp)
DO i_u = 1, atoms%n_u
l = atoms%lda_u(i_u)%l
itype = atoms%lda_u(i_u)%atomType
......@@ -139,13 +140,25 @@ CONTAINS
END DO
END DO
END DO
DO j=-3,3
WRITE(6,'(14f12.6)') (n_mmp_in(k,j,1,2),k=-3,3)
END DO
!DO j=-3,3
! WRITE(6,'(14f12.6)') (n_mmp_in(k,j,1,2),k=-3,3)
!END DO
WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 2 =',sum2
DO j=-3,3
WRITE(6,'(14f12.6)') (n_mmp_out(k,j,1,2),k=-3,3)
END DO
!DO j=-3,3
! WRITE(6,'(14f12.6)') (n_mmp_out(k,j,1,2),k=-3,3)
!END DO
IF(noco%l_mperp) THEN
!Spin off-diagonal
sum3 = 0.0
DO i_u = 1, atoms%n_u
DO j = -3,3
DO k = -3,3
sum2 = sum2 + ABS(n_mmp_out(k,j,i_u,3) - n_mmp_in(k,j,i_u,3))
END DO
END DO
END DO
WRITE (6,'(a23,f12.6)') 'n_mmp distance spin 3 =',sum3
ENDIF
END IF
END IF ! input%ldauLinMix
......
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