Commit 6d90ed35 authored by Matthias Redies's avatar Matthias Redies

remove redundant pw calculation of kED

parent 1f9db123
......@@ -101,10 +101,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL orbcomp%init(input,banddos,dimension,atoms,kpts)
CALL outDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
do dim_idx = 1,3
CALL xcpot%comparison_kinED_pw(dim_idx)%init(stars,atoms,sphhar,vacuum,&
noco,input%jspins, POTDEN_TYPE_DEN)
enddo
CALL EnergyDen%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_EnergyDen)
IF (mpi%irank == 0) CALL openXMLElementNoAttributes('valenceDensity')
......@@ -120,16 +116,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL cdnvalJob%init(mpi,input,kpts,noco,results,jspin,sliceplot,banddos)
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,coreSpecInput,mcd,slab,orbcomp)
do dim_idx =1,3
fake_regCharges = regCharges
fake_dos = dos
fake_results = results
fake_moments = moments
CALL calc_kinED_pw(dim_idx,eig_id,mpi,kpts,jspin,noco,input,banddos,cell,&
atoms,enpara,stars,vacuum,dimension,sphhar,sym,vTot,oneD,&
cdnvalJob,xcpot%comparison_kinED_pw(dim_idx),fake_regCharges,&
fake_dos,fake_results,fake_moments)
enddo
END DO
call xcpot%val_den%copyPotDen(outDen)
......@@ -137,7 +123,6 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
if(xcpot%exc_is_metagga()) then
CALL calc_EnergyDen(eig_id, mpi, kpts, noco, input, banddos, cell, atoms, enpara, stars,&
vacuum, DIMENSION, sphhar, sym, vTot, oneD, results, EnergyDen)
call save_kinED(xcpot, input, noco, stars, cell, sym)
endif
IF (mpi%irank == 0) THEN
......@@ -232,39 +217,4 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
END SUBROUTINE cdngen
subroutine save_kinED(xcpot, input, noco, stars, cell, sym)
use m_types
use m_pw_tofrom_grid
use m_judft_stop
implicit none
CLASS(t_xcpot),INTENT(IN) :: xcpot
type(t_input), intent(in) :: input
type(t_noco), intent(in) :: noco
type(t_stars), intent(in) :: stars
type(t_cell), intent(in) :: cell
TYPE(t_sym),INTENT(IN) :: sym
integer :: dim_idx
real, allocatable :: tmp(:,:), kinED(:,:)
type(t_gradients) :: grad
character(len=1000) :: filename
call init_pw_grid(xcpot, stars, sym, cell)
do dim_idx = 1,3
call pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, cell, &
xcpot%comparison_kinED_pw(dim_idx)%pw, grad, tmp)
if(.not. allocated(kinED)) then
allocate(kinED, mold=tmp)
kinED = 0.0
endif
kinEd = kinED + tmp
enddo
kinED = 0.5 * kinED
call finish_pw_grid()
end subroutine save_kinED
END MODULE m_cdngen
......@@ -23,7 +23,7 @@ MODULE m_types_xcpot
TYPE,ABSTRACT :: t_xcpot
REAL :: gmaxxc
TYPE(t_potden) :: comparison_kinED_pw(3), core_den, val_den
TYPE(t_potden) :: core_den, val_den
TYPE(t_grid), allocatable :: mt_lapl(:), mt_kED_schr(:)
CONTAINS
PROCEDURE :: vxc_is_LDA=>xcpot_vxc_is_LDA
......
......@@ -149,193 +149,6 @@ CONTAINS
ENDDO
END SUBROUTINE calc_EnergyDen_auxillary_weights
SUBROUTINE calc_kinED_pw(dim_idx, eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,stars,&
vacuum,dimension,sphhar,sym,vTot,oneD,cdnvalJob,kinED,regCharges,dos,results,&
moments,coreSpecInput,mcd,slab,orbcomp)
USE m_types
USE m_eig66_io
USE m_genMTBasis
USE m_calcDenCoeffs
USE m_mcdinit
USE m_sympsi
USE m_eparas ! energy parameters and partial charges
USE m_qal21 ! off-diagonal part of partial charges
USE m_abcof
USE m_nmat ! calculate density matrix for LDA + U
USE m_vacden
USE m_pwden
USE m_forcea8
USE m_checkdopall
USE m_cdnmt ! calculate the density and orbital moments etc.
USE m_orbmom ! coeffd for orbital moments
USE m_qmtsl ! These subroutines divide the input%film into vacuum%layers
USE m_qintsl ! (slabs) and intergate the DOS in these vacuum%layers
USE m_orbcomp ! calculate orbital composition (like p_x,p_y,p_z)
USE m_abcrot2
USE m_corespec, only : l_cs ! calculation of core spectra (EELS)
USE m_corespec_io, only : corespec_init
USE m_corespec_eval, only : corespec_gaunt,corespec_rme,corespec_dos,corespec_ddscs
USE m_xmlOutput
#ifdef CPP_MPI
USE m_mpi_col_den ! collect density data from parallel nodes
#endif
IMPLICIT NONE
TYPE(t_results), INTENT(INOUT) :: results
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_enpara), INTENT(IN) :: enpara
TYPE(t_banddos), INTENT(IN) :: banddos
TYPE(t_input), INTENT(IN) :: input
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_kpts), INTENT(IN) :: kpts
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_potden), INTENT(IN) :: vTot
TYPE(t_cdnvalJob), INTENT(IN) :: cdnvalJob
TYPE(t_potden), INTENT(INOUT) :: kinED
TYPE(t_regionCharges), INTENT(INOUT) :: regCharges
TYPE(t_dos), INTENT(INOUT) :: dos
TYPE(t_moments), INTENT(INOUT) :: moments
TYPE(t_coreSpecInput), OPTIONAL, INTENT(IN) :: coreSpecInput
TYPE(t_mcd), OPTIONAL, INTENT(INOUT) :: mcd
TYPE(t_slab), OPTIONAL, INTENT(INOUT) :: slab
TYPE(t_orbcomp), OPTIONAL, INTENT(INOUT) :: orbcomp
! Scalar Arguments
INTEGER, INTENT(IN) :: eig_id, jspin, dim_idx
#ifdef CPP_MPI
INCLUDE 'mpif.h'
#endif
! Local Scalars
INTEGER :: ikpt,jsp_start,jsp_end,ispin,jsp
INTEGER :: iErr,nbands,noccbd,iType
INTEGER :: skip_t,skip_tt,nStart,nEnd,nbasfcn
LOGICAL :: l_orbcomprot, l_real, l_dosNdir
! Local Arrays
REAL, ALLOCATABLE :: we(:)
REAL, ALLOCATABLE :: eig(:)
REAL, ALLOCATABLE :: f(:,:,:,:),g(:,:,:,:),flo(:,:,:,:) ! radial functions
TYPE (t_lapw) :: lapw
TYPE (t_orb) :: orb
TYPE (t_denCoeffs) :: denCoeffs
TYPE (t_denCoeffsOffdiag) :: denCoeffsOffdiag
TYPE (t_force) :: force
TYPE (t_eigVecCoeffs) :: eigVecCoeffs
TYPE (t_usdus) :: usdus
TYPE (t_mat) :: zMat, zPrime
TYPE (t_potden) :: kinED_comp(3)
TYPE (t_gVacMap) :: gVacMap
l_real = sym%invs.AND.(.NOT.noco%l_soc).AND.(.NOT.noco%l_noco)
l_dosNdir = banddos%dos.AND.(banddos%ndir == -3)
IF (noco%l_mperp) THEN
! when the off-diag. part of the desinsity matrix, i.e. m_x and
! m_y, is calculated inside the muffin-tins (l_mperp = T), cdnval
! is called only once. therefore, several spin loops have been
! added. if l_mperp = F, these loops run only from jspin - jspin.
jsp_start = 1
jsp_end = 2
ELSE
jsp_start = jspin
jsp_end = jspin
END IF
ALLOCATE (f(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end)) ! Deallocation before mpi_col_den
ALLOCATE (g(atoms%jmtd,2,0:atoms%lmaxd,jsp_start:jsp_end))
ALLOCATE (flo(atoms%jmtd,2,atoms%nlod,input%jspins))
! Initializations
CALL usdus%init(atoms,input%jspins)
CALL denCoeffs%init(atoms,sphhar,jsp_start,jsp_end)
! The last entry in denCoeffsOffdiag%init is l_fmpl. It is meant as a switch to a plot of the full magnet.
! density without the atomic sphere approximation for the magnet. density. It is not completely implemented (lo's missing).
CALL denCoeffsOffdiag%init(atoms,noco,sphhar,noco%l_mtnocopot)
CALL force%init1(input,atoms)
CALL orb%init(atoms,noco,jsp_start,jsp_end)
IF (denCoeffsOffdiag%l_fmpl.AND.(.NOT.noco%l_mperp)) CALL juDFT_error("for fmpl set noco%l_mperp = T!" ,calledby ="cdnval")
IF (l_dosNdir.AND.oneD%odi%d1) CALL juDFT_error("layer-resolved feature does not work with 1D",calledby ="cdnval")
IF (banddos%l_mcd.AND..NOT.PRESENT(mcd)) CALL juDFT_error("mcd is missing",calledby ="cdnval")
DO iType = 1, atoms%ntype
DO ispin = jsp_start, jsp_end
CALL genMTBasis(atoms,enpara,vTot,mpi,iType,ispin,usdus,f(:,:,0:,ispin),g(:,:,0:,ispin),flo(:,:,:,ispin))
END DO
IF (noco%l_mperp) CALL denCoeffsOffdiag%addRadFunScalarProducts(atoms,f,g,flo,iType)
IF (banddos%l_mcd) CALL mcd_init(atoms,input,dimension,vTot%mt(:,0,:,:),g,f,mcd,iType,jspin)
END DO
DEALLOCATE (f,g,flo)
skip_tt = dot_product(enpara%skiplo(:atoms%ntype,jspin),atoms%neq(:atoms%ntype))
IF (noco%l_soc.OR.noco%l_noco) skip_tt = 2 * skip_tt
ALLOCATE (we(MAXVAL(cdnvalJob%noccbd(:))))
ALLOCATE (eig(MAXVAL(cdnvalJob%noccbd(:))))
jsp = MERGE(1,jspin,noco%l_noco)
DO ikpt = cdnvalJob%ikptStart, cdnvalJob%nkptExtended, cdnvalJob%ikptIncrement
IF (ikpt > kpts%nkpt) THEN
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
EXIT
END IF
CALL lapw%init(input,noco, kpts,atoms,sym,ikpt,cell,.false., mpi)
skip_t = skip_tt
noccbd = cdnvalJob%noccbd(ikpt)
nStart = cdnvalJob%nStart(ikpt)
nEnd = cdnvalJob%nEnd(ikpt)
we(1:noccbd) = cdnvalJob%weights(1:noccbd,ikpt)
eig(1:noccbd) = results%eig(nStart:nEnd,ikpt,jsp)
IF (cdnvalJob%l_evp) THEN
IF (nStart > skip_tt) skip_t = 0
IF (nEnd <= skip_tt) skip_t = noccbd
IF ((nStart <= skip_tt).AND.(nEnd > skip_tt)) skip_t = mod(skip_tt,noccbd)
END IF
nbasfcn = MERGE(lapw%nv(1)+lapw%nv(2)+2*atoms%nlotot,lapw%nv(1)+atoms%nlotot,noco%l_noco)
CALL zMat%init(l_real,nbasfcn,noccbd)
CALL read_eig(eig_id,ikpt,jsp,n_start=nStart,n_end=nEnd,neig=nbands,zmat=zMat)
call set_zPrime(dim_idx, zMat, kpts%bk(:,ikpt), lapw, cell, zPrime)
#ifdef CPP_MPI
CALL MPI_BARRIER(mpi%mpi_comm,iErr) ! Synchronizes the RMA operations
#endif
IF (noccbd.LE.0) CYCLE ! Note: This jump has to be after the MPI_BARRIER is called
CALL gVacMap%init(dimension,sym,atoms,vacuum,stars,lapw,input,cell,kpts,enpara,vTot,ikpt,jspin)
! valence density in the interstitial and vacuum region has to be called only once (if jspin=1) in the non-collinear case
IF (.NOT.((jspin == 2).AND.noco%l_noco)) THEN
! valence density in the interstitial region
CALL pwden(stars,kpts,banddos,oneD,input,mpi,noco,cell,atoms,sym,ikpt,&
jspin,lapw,noccbd,we,eig,kinED,results,force%f_b8,zPrime,dos)
END IF
END DO ! end of k-point loop
#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,kinED,kinED%mmpMat(:,:,:,jspin),mcd,slab,orbcomp)
END DO
#endif
END SUBROUTINE calc_kinED_pw
subroutine set_zPrime(dim_idx, zMat, kpt, lapw, cell, zPrime)
USE m_types
USE m_constants
......
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