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 ...@@ -13,6 +13,7 @@ cdn/int_21.f90
cdn/int_21lo.f90 cdn/int_21lo.f90
cdn/m_perp.f90 cdn/m_perp.f90
cdn/n_mat.f90 cdn/n_mat.f90
cdn/n_mat21.f90
cdn/od_abvac.f90 cdn/od_abvac.f90
cdn/prp_qfft_map.f90 cdn/prp_qfft_map.f90
cdn/pwden.F90 cdn/pwden.F90
......
...@@ -12,7 +12,7 @@ CONTAINS ...@@ -12,7 +12,7 @@ CONTAINS
SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,& 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,& 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 ! 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 ...@@ -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_qal21 ! off-diagonal part of partial charges
USE m_abcof USE m_abcof
USE m_nmat ! calculate density matrix for LDA + U USE m_nmat ! calculate density matrix for LDA + U
USE m_nmat21
USE m_vacden USE m_vacden
USE m_pwden USE m_pwden
USE m_forcea8 USE m_forcea8
...@@ -85,6 +86,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -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_greensfCoeffs), OPTIONAL, INTENT(INOUT) :: greensfCoeffs
TYPE(t_greensf), OPTIONAL, INTENT(INOUT) :: greensf TYPE(t_greensf), OPTIONAL, INTENT(INOUT) :: greensf
REAL, OPTIONAL, INTENT(IN) :: angle(sym%nop) 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 ! Scalar Arguments
INTEGER, INTENT(IN) :: eig_id, jspin INTEGER, INTENT(IN) :: eig_id, jspin
...@@ -243,7 +245,8 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st ...@@ -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,& CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,&
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),& eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force) 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),& 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) 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 ...@@ -284,7 +287,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
#ifdef CPP_MPI #ifdef CPP_MPI
DO ispin = jsp_start,jsp_end DO ispin = jsp_start,jsp_end
CALL mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,ispin,regCharges,dos,& 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) mcd,slab,orbcomp,greensfCoeffs,greensf)
END DO END DO
#endif #endif
......
...@@ -102,6 +102,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -102,6 +102,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
#endif #endif
LOGICAL :: l_error, perform_MetaGGA LOGICAL :: l_error, perform_MetaGGA
REAL :: angle(sym%nop) 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,& ...@@ -122,6 +123,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
ENDIF ENDIF
IF(atoms%n_gf+atoms%n_u.GT.0.AND.noco%l_mperp) THEN IF(atoms%n_gf+atoms%n_u.GT.0.AND.noco%l_mperp) THEN
n_mmp21 = 0.0
CALL angles(sym,angle) CALL angles(sym,angle)
ENDIF ENDIF
...@@ -143,7 +145,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,& ...@@ -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) 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,& 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,& 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 END DO
IF(PRESENT(gOnsite).AND.mpi%irank.EQ.0) THEN IF(PRESENT(gOnsite).AND.mpi%irank.EQ.0) THEN
......
...@@ -12,7 +12,7 @@ MODULE m_mpi_col_den ...@@ -12,7 +12,7 @@ MODULE m_mpi_col_den
! !
CONTAINS CONTAINS
SUBROUTINE mpi_col_den(mpi,sphhar,atoms,oneD,stars,vacuum,input,noco,jspin,regCharges,dos,& 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" #include"cpp_double.h"
USE m_types USE m_types
...@@ -37,6 +37,7 @@ CONTAINS ...@@ -37,6 +37,7 @@ CONTAINS
! .. ! ..
! .. Array Arguments .. ! .. Array Arguments ..
COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u) COMPLEX,INTENT(INOUT) :: n_mmp(-lmaxU_const:lmaxU_const,-lmaxU_const:lmaxU_const,atoms%n_u)
TYPE (t_orb), INTENT(INOUT) :: orb TYPE (t_orb), INTENT(INOUT) :: orb
TYPE (t_denCoeffs), INTENT(INOUT) :: denCoeffs TYPE (t_denCoeffs), INTENT(INOUT) :: denCoeffs
TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag TYPE (t_denCoeffsOffdiag), INTENT(INOUT) :: denCoeffsOffdiag
...@@ -47,6 +48,7 @@ CONTAINS ...@@ -47,6 +48,7 @@ CONTAINS
TYPE (t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp TYPE (t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp
TYPE (t_greensfCoeffs), OPTIONAL, INTENT(INOUT) :: greensfCoeffs TYPE (t_greensfCoeffs), OPTIONAL, INTENT(INOUT) :: greensfCoeffs
TYPE (t_greensf), OPTIONAL, INTENT(INOUT) :: greensf 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 .. ! .. Local Scalars ..
INTEGER :: n, i INTEGER :: n, i
...@@ -420,6 +422,15 @@ CONTAINS ...@@ -420,6 +422,15 @@ CONTAINS
CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp, 1) CALL CPP_BLAS_ccopy(n, c_b, 1, n_mmp, 1)
ENDIF ENDIF
DEALLOCATE (c_b) 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 ENDIF
!-lda+U !-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