Commit 0b3da1ff authored by Matthias Redies's avatar Matthias Redies

moved kinED to end of cdngen (untested)

parent 2390e5c1
......@@ -81,6 +81,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
TYPE(t_slab) :: slab
TYPE(t_orbcomp) :: orbcomp
TYPE(t_cdnvalJob) :: cdnvalJob
TYPE(t_potden) :: val_den, core_den
!Local Scalars
......@@ -117,7 +118,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
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)
END DO
call xcpot%val_den%copyPotDen(outDen)
call val_den%copyPotDen(outDen)
! calculate kinetic energy density for MetaGGAs
if(xcpot%exc_is_metagga()) then
......@@ -170,7 +171,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL cdncore(mpi,dimension,oneD,input,vacuum,noco,sym,&
stars,cell,sphhar,atoms,vTot,outDen,moments,results)
endif
call xcpot%core_den%subPotDen(outDen, xcpot%val_den)
call core_den%subPotDen(outDen, val_den)
CALL timestop("cdngen: cdncore")
CALL enpara%calcOutParams(input,atoms,vacuum,regCharges)
......@@ -198,7 +199,9 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
END IF
END IF ! mpi%irank == 0
call set_kinED(mpi, sphhar, atoms, core_den, val_den, xcpot, &
input, noco, stars, cell, outDen, EnergyDen, vTot)
#ifdef CPP_MPI
CALL MPI_BCAST(noco%l_ss,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
CALL MPI_BCAST(noco%l_mperp,1,MPI_LOGICAL,0,mpi%mpi_comm,ierr)
......
......@@ -27,7 +27,6 @@ MODULE m_types_xcpot
TYPE,ABSTRACT :: t_xcpot
REAL :: gmaxxc
TYPE(t_potden) :: core_den, val_den
TYPE(t_kinED) :: kinED
CONTAINS
PROCEDURE :: vxc_is_LDA => xcpot_vxc_is_LDA
......
......@@ -34,7 +34,7 @@
USE m_juDFT_string
IMPLICIT NONE
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
......
......@@ -178,4 +178,114 @@ CONTAINS
res = matmul(transpose(cell%bmat), vec)
end function internal_to_rez
subroutine set_kinED(mpi, sphhar, atoms, core_den, val_den, xcpot, &
input, noco, stars, cell, den, EnergyDen, vTot)
use m_types
implicit none
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: core_den, val_den
CLASS(t_xcpot),INTENT(INOUT) :: 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_potden),INTENT(IN) :: den, EnergyDen, vTot
call set_kinED_is(xcpot, input, noco, stars, cell, den, EnergyDen, vTot)
call set_kinED_mt(mpi, sphhar, atoms, core_den, val_den, &
xcpot, EnergyDen, input, vTot)
end subroutine set_kinED
subroutine set_kinED_is(xcpot, input, noco, stars, cell, den, EnergyDen, vTot)
use m_types
use m_pw_tofrom_grid
implicit none
CLASS(t_xcpot),INTENT(INOUT) :: 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_potden),INTENT(IN) :: den, EnergyDen, vTot
!local arrays
REAL, ALLOCATABLE :: den_rs(:,:), ED_rs(:,:), vTot_rs(:,:)
TYPE(t_gradients) :: tmp_grad
CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
cell, EnergyDen%pw, tmp_grad, ED_rs)
CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
cell, vTot%pw, tmp_grad, vTot_rs)
CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
cell, den%pw, tmp_grad, den_rs)
xcpot%kinED%is = ED_RS - vTot_RS * den_RS
xcpot%kinED%set = .True.
end subroutine set_kinED_is
subroutine set_kinED_mt(mpi, sphhar, atoms, core_den, val_den, &
xcpot, EnergyDen, input, vTot)
use m_types
use m_mt_tofrom_grid
implicit none
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: core_den, val_den, EnergyDen, vTot
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
TYPE(t_input),INTENT(IN) :: input
INTEGER :: jr, loc_n, n, n_start, n_stride, cnt
REAL,ALLOCATABLE :: vTot_mt(:,:,:), ED_rs(:,:), vTot_rs(:,:), vTot0_rs(:,:),&
core_den_rs(:,:), val_den_rs(:,:)
TYPE(t_gradients) :: tmp_grad
TYPE(t_sphhar) :: tmp_sphhar
#ifdef CPP_MPI
n_start=mpi%irank+1
n_stride=mpi%isize
#else
n_start=1
n_stride=1
#endif
loc_n = 0
call xcpot%kinED%alloc_mt(atoms%nsp()*atoms%jmtd, input%jspins, &
n_start, atoms%ntype, n_stride)
loc_n = 0
do n = n_start,atoms%ntype,n_stride
loc_n = loc_n + 1
if(.not. allocated(vTot_mt)) then
allocate(vTot_mt(lbound(vTot%mt, dim=1):ubound(vTot%mt, dim=1),&
lbound(vTot%mt, dim=2):ubound(vTot%mt, dim=2),&
lbound(vTot%mt, dim=4):ubound(vTot%mt, dim=4)))
write (*,*) "lbound vTot_mt = ", lbound(vTot_mt)
write (*,*) "ubound vTot_mt = ", ubound(vTot_mt)
write (*,*) "lbound vTot%mt = ", lbound(vTot%mt)
write (*,*) "ubound vTot%mt = ", ubound(vTot%mt)
endif
do jr=1,atoms%jri(n)
vTot_mt(jr,0:,:) = vTot%mt(jr,0:,n,:) * atoms%rmsh(jr,n)**2
enddo
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, EnergyDen%mt(:, 0:, n, :), &
n, tmp_grad, ED_rs)
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, vTot_mt(:,0:,:), &
n, tmp_grad, vTot_rs)
tmp_sphhar%nlhd = sphhar%nlhd
tmp_sphhar%nlh = [(0, cnt=1,size(sphhar%nlh))]
CALL mt_to_grid(xcpot, input%jspins, atoms, tmp_sphhar, vTot_mt(:,0:0,:), &
n, tmp_grad, vTot0_rs)
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, &
core_den%mt(:,0:,n,:), n, tmp_grad, core_den_rs)
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, &
val_den%mt(:,0:,n,:), n, tmp_grad, val_den_rs)
xcpot%kinED%mt(:,:,loc_n) = ED_RS - (vTot0_rs * core_den_rs + vTot_rs * val_den_rs)
enddo
xcpot%kinED%set = .True.
end subroutine set_kinED_mt
END MODULE m_metagga
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