Commit a461a728 authored by Henning Janssen's avatar Henning Janssen

Added extra spin dimension to potden%mmpmat for offdiagonal contribution

parent 8554947e
......@@ -12,7 +12,7 @@ CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,vTot,oneD,cdnvalJob,den,regCharges,dos,results,&
moments,hub1,coreSpecInput,mcd,slab,orbcomp,greensfCoeffs,greensf,angle,n_mmp21)
moments,hub1,coreSpecInput,mcd,slab,orbcomp,greensfCoeffs,greensf,angle)
!************************************************************************************
! This is the FLEUR valence density generator
......@@ -86,7 +86,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
TYPE(t_greensfCoeffs), OPTIONAL, INTENT(INOUT) :: greensfCoeffs
TYPE(t_greensf), OPTIONAL, INTENT(INOUT) :: greensf
REAL, OPTIONAL, INTENT(IN) :: angle(sym%nop)
COMPLEX, OPTIONAL, INTENT(INOUT) :: n_mmp21(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
! Scalar Arguments
INTEGER, INTENT(IN) :: eig_id, jspin
......@@ -246,7 +245,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,n_mmp21)
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_gf.GT.0) CALL bzIntegrationGF(atoms,sym,input,angle,ispin,noccbd,dosWeights,resWeights,dosBound,kpts%wtkpt(ikpt),&
eig,denCoeffsOffdiag,usdus,eigVecCoeffs,greensf,greensfCoeffs,ispin==jsp_end)
......@@ -287,8 +287,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
#ifdef CPP_MPI
DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,1:atoms%n_u,ispin),n_mmp21,&
mcd,slab,orbcomp,greensfCoeffs,greensf)
results,denCoeffs,orb,denCoeffsOffdiag,den,mcd,slab,orbcomp,greensfCoeffs,greensf)
END DO
#endif
......
......@@ -97,6 +97,7 @@ CONTAINS
END DO
ENDDO
!Include contribution from LDA+U and LDA+HIA (latter are behind LDA+U contributions)
IF(jsp<3) THEN !offdiagonal contributions are added currently in hsmt_u_offdiag
DO i_u=1,atoms%n_u+atoms%n_hia
IF (n.NE.atoms%lda_u(i_u)%atomType) CYCLE
!Found a "U" for this atom type
......@@ -111,6 +112,7 @@ CONTAINS
ENDDO
ENDDO
END DO
ENDIF
!Now add diagonal contribution to matrices
IF (jsp<3) THEN
......
......@@ -102,7 +102,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
#endif
LOGICAL :: l_error, perform_MetaGGA
REAL :: angle(sym%nop)
COMPLEX :: n_mmp21(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
......@@ -122,10 +121,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF(atoms%n_hia.GT.0.AND.mpi%irank==0) hub1%mag_mom = 0.0
ENDIF
IF(atoms%n_gf+atoms%n_u.GT.0.AND.noco%l_mperp) THEN
n_mmp21 = 0.0
CALL angles(sym,angle)
ENDIF
IF(atoms%n_gf+atoms%n_u.GT.0.AND.noco%l_mperp) CALL angles(sym,angle)
CALL outDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
......@@ -145,7 +141,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (sliceplot%slice) CALL cdnvalJob%select_slice(sliceplot,results,input,kpts,noco,jspin)
CALL cdnval(eig_id,mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,vacuum,dimension,&
sphhar,sym,vTot,oneD,cdnvalJob,outDen,regCharges,dos,results,moments,hub1,coreSpecInput,&
mcd,slab,orbcomp,greensfCoeffs,gOnsite,angle,n_mmp21)
mcd,slab,orbcomp,greensfCoeffs,gOnsite,angle)
END DO
IF(PRESENT(gOnsite).AND.mpi%irank.EQ.0) THEN
......
......@@ -12,7 +12,7 @@ MODULE m_mpi_col_den
!
CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,&
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp,n_mmp21,mcd,slab,orbcomp,greensfCoeffs,greensf)
results,denCoeffs,orb,denCoeffsOffdiag,den,mcd,slab,orbcomp,greensfCoeffs,greensf)
#include"cpp_double.h"
USE m_types
......@@ -36,7 +36,6 @@ CONTAINS
INTEGER, INTENT (IN) :: jspin
! ..
! .. Array Arguments ..
COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
TYPE (t_orb), INTENT(INOUT) :: orb
TYPE (t_denCoeffs), INTENT(INOUT) :: denCoeffs
......@@ -48,7 +47,6 @@ CONTAINS
TYPE (t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp
TYPE (t_greensfCoeffs), OPTIONAL, INTENT(INOUT) :: greensfCoeffs
TYPE (t_greensf), OPTIONAL, INTENT(INOUT) :: greensf
COMPLEX, OPTIONAL,INTENT(INOUT) :: n_mmp21(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
! ..
! .. Local Scalars ..
INTEGER :: n, i
......@@ -417,17 +415,17 @@ CONTAINS
IF ( atoms%n_u.GT.0 ) THEN
n = 49*atoms%n_u
ALLOCATE(c_b(n))
CALL MPI_REDUCE(n_mmp,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(den%mmpMat(:,:,1:atoms%n_u,ispin),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, den%mmpMat(:,:,1:atoms%n_u,ispin), 1)
ENDIF
DEALLOCATE (c_b)
IF(noco%l_mperp.AND.PRESENT(n_mmp21).AND.jspin.EQ.1) THEN
IF(noco%l_mperp.AND.jspin.EQ.1) THEN
n = 49*atoms%n_u
ALLOCATE(c_b(n))
CALL MPI_REDUCE(n_mmp21,c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
CALL MPI_REDUCE(den%mmpMat(:,:,1:atoms%n_u,3),c_b,n,CPP_MPI_COMPLEX,MPI_SUM,0, MPI_COMM_WORLD,ierr)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp21, 1)
CALL CPP_BLAS_ccopy(n, c_b, 1, den%mmpMat(:,:,1:atoms%n_u,3), 1)
ENDIF
DEALLOCATE (c_b)
ENDIF
......
......@@ -274,17 +274,17 @@ CONTAINS
INTEGER,INTENT(IN) :: jspins, potden_type
CALL init_potden_simple(pd,stars%ng3,atoms%jmtd,sphhar%nlhd,atoms%ntype,&
atoms%n_u+atoms%n_hia,jspins,noco%l_noco,noco%l_mtnocopot,potden_type,&
atoms%n_u+atoms%n_hia,jspins,noco%l_noco,noco%l_mtnocopot,noco%l_mperp,potden_type,&
vacuum%nmzd,vacuum%nmzxyd,stars%ng2)
END SUBROUTINE init_potden_types
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,n_u,jspins,nocoExtraDim,nocoExtraMTDim,potden_type,nmzd,nmzxyd,n2d)
SUBROUTINE init_potden_simple(pd,ng3,jmtd,nlhd,ntype,n_u,jspins,nocoExtraDim,nocoExtraMTDim,nocoExtraUDim,potden_type,nmzd,nmzxyd,n2d)
USE m_constants
USE m_judft
IMPLICIT NONE
CLASS(t_potden),INTENT(OUT) :: pd
INTEGER,INTENT(IN) :: ng3,jmtd,nlhd,ntype,n_u,jspins,potden_type
LOGICAL,INTENT(IN) :: nocoExtraDim,nocoExtraMTDim
LOGICAL,INTENT(IN) :: nocoExtraDim,nocoExtraMTDim,nocoExtraUDim
INTEGER,INTENT(IN) :: nmzd,nmzxyd,n2d
INTEGER:: err(4)
......@@ -302,7 +302,7 @@ CONTAINS
ALLOCATE (pd%vacz(nmzd,2,MERGE(4,jspins,nocoExtraDim)),stat=err(3))
ALLOCATE (pd%vacxy(nmzxyd,n2d-1,2,MERGE(3,jspins,nocoExtraDim)),stat=err(4))
ALLOCATE (pd%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_u),jspins))
ALLOCATE (pd%mmpMat(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,MAX(1,n_u),MERGE(3,jspins,nocoExtraUDim)))
IF (ANY(err>0)) CALL judft_error("Not enough memory allocating potential or density")
pd%pw=CMPLX(0.0,0.0)
......
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