Commit 7148173c authored by Henning Janssen's avatar Henning Janssen

First version of off-diagonal occupation matrix for LDA+U with noco%l_mperp

parent 499fc77c
......@@ -13,6 +13,7 @@ cdn/int_21.f90
cdn/int_21lo.f90
cdn/m_perp.f90
cdn/n_mat.f90
cdn/n_mat21.f90
cdn/od_abvac.f90
cdn/prp_qfft_map.f90
cdn/pwden.F90
......
......@@ -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)
moments,hub1,coreSpecInput,mcd,slab,orbcomp,greensfCoeffs,greensf,angle,n_mmp21)
!************************************************************************************
! This is the FLEUR valence density generator
......@@ -34,6 +34,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
USE m_qal21 ! off-diagonal part of partial charges
USE m_abcof
USE m_nmat ! calculate density matrix for LDA + U
USE m_nmat21
USE m_vacden
USE m_pwden
USE m_forcea8
......@@ -85,6 +86,7 @@ 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
......@@ -243,7 +245,8 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,&
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(:,:,:,jspin))
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_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)
......@@ -284,7 +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,jspin),&
results,denCoeffs,orb,denCoeffsOffdiag,den,den%mmpMat(:,:,1:atoms%n_u,ispin),n_mmp21,&
mcd,slab,orbcomp,greensfCoeffs,greensf)
END DO
#endif
......
......@@ -102,6 +102,7 @@ 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,6 +123,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
ENDIF
IF(atoms%n_gf+atoms%n_u.GT.0.AND.noco%l_mperp) THEN
n_mmp21 = 0.0
CALL angles(sym,angle)
ENDIF
......@@ -143,7 +145,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)
mcd,slab,orbcomp,greensfCoeffs,gOnsite,angle,n_mmp21)
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,mcd,slab,orbcomp,greensfCoeffs,greensf)
results,denCoeffs,orb,denCoeffsOffdiag,den,n_mmp,n_mmp21,mcd,slab,orbcomp,greensfCoeffs,greensf)
#include"cpp_double.h"
USE m_types
......@@ -37,6 +37,7 @@ CONTAINS
! ..
! .. 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
TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
......@@ -47,6 +48,7 @@ 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
......@@ -420,6 +422,15 @@ CONTAINS
CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp, 1)
ENDIF
DEALLOCATE (c_b)
IF(noco%l_mperp.AND.PRESENT(n_mmp21).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)
IF (mpi%irank.EQ.0) THEN
CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp21, 1)
ENDIF
DEALLOCATE (c_b)
ENDIF
ENDIF
!-lda+U
......
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