Commit aec52306 authored by Daniel Wortmann's avatar Daniel Wortmann

Changed data flow of metagga to start reenabling this feature

parent fa2712b7
......@@ -231,13 +231,14 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
END IF
END IF ! mpi%irank == 0
perform_MetaGGA = ALLOCATED(EnergyDen%mt) &
.AND. (xcpot%exc_is_MetaGGA() .or. xcpot%vx_is_MetaGGA())
if(perform_MetaGGA) then
call set_kinED(mpi, sphhar, atoms, sym, core_den, val_den, xcpot, &
input, noco, stars, cell, outDen, EnergyDen, vTot)
Perform_metagga = Allocated(Energyden%Mt) &
.And. (Xcpot%Exc_is_metagga() .Or. Xcpot%Vx_is_metagga())
If(Perform_metagga) Then
CALL writeDensity(stars,noco,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,core_den,'cdnc')
endif
#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)
......
......@@ -34,6 +34,7 @@ CONTAINS
USE m_convol
USE m_cdntot
USE m_intgr
USE m_metagga
IMPLICIT NONE
......@@ -57,6 +58,7 @@ CONTAINS
! Local type instances
TYPE(t_potden) :: workDen, exc, veff
Type(t_kinED) :: kinED
REAL, ALLOCATABLE :: tmp_mt(:,:,:), tmp_is(:,:)
REAL, ALLOCATABLE :: rhoc(:,:,:),rhoc_vx(:)
REAL, ALLOCATABLE :: tec(:,:), qintc(:,:)
......@@ -70,6 +72,10 @@ CONTAINS
CALL exc%init(stars, atoms, sphhar, vacuum, noco, 1, 1) !one spin only
ALLOCATE (exc%pw_w(stars%ng3, 1)); exc%pw_w = 0.0
call set_kinED(mpi, sphhar, atoms, sym, xcpot, &
input, noco, stars, cell, Den, EnergyDen, vTot,kinED)
IF (PRESENT(results)) THEN
CALL veff%init(stars, atoms, sphhar, vacuum, noco, input%jspins, 1)
#ifndef CPP_OLDINTEL
......@@ -115,7 +121,7 @@ CONTAINS
! interstitial region
CALL timestart("Vxc in interstitial")
CALL vis_xc(stars, sym, cell, den, xcpot, input, noco, EnergyDen, vTot, vx, exc)
CALL vis_xc(stars, sym, cell, den, xcpot, input, noco, EnergyDen,kinED, vTot, vx, exc)
CALL timestop("Vxc in interstitial")
END IF !irank==0
......@@ -128,7 +134,7 @@ CONTAINS
END IF
CALL vmt_xc(mpi, sphhar, atoms, den, xcpot, input, sym, &
EnergyDen, noco,vTot, vx, exc)
EnergyDen,kinED, noco,vTot, vx, exc)
! add MT EXX potential to vr
IF (mpi%irank == 0) THEN
......
......@@ -17,7 +17,7 @@ MODULE m_vis_xc
! including gradient corrections. t.a. 1996.
! ******************************************************
CONTAINS
SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco,EnergyDen,vTot,vx,exc)
SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco,EnergyDen,kinED,vTot,vx,exc)
! ******************************************************
! instead of visxcor.f: the different exchange-correlation
......@@ -45,6 +45,7 @@ CONTAINS
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(IN) :: den, EnergyDen
TYPE(t_potden),INTENT(INOUT) :: vTot,vx,exc
TYPE(t_kinED),INTENT(IN) ::kinED
TYPE(t_gradients) :: grad, tmp_grad
REAL, ALLOCATABLE :: rho(:,:), ED_rs(:,:), vTot_rs(:,:)
......@@ -63,8 +64,8 @@ CONTAINS
ALLOCATE(v_xc,mold=rho)
ALLOCATE(v_x,mold=rho)
#ifdef CPP_LIBXC
if(perform_MetaGGA .and. xcpot%kinED%set) then
CALL xcpot%get_vxc(input%jspins,rho,v_xc, v_x,grad, kinED_KS=xcpot%kinED%is)
if(perform_MetaGGA .and. kinED%set) then
CALL xcpot%get_vxc(input%jspins,rho,v_xc, v_x,grad, kinED_KS=kinED%is)
else
CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
endif
......@@ -85,8 +86,8 @@ CONTAINS
IF (ALLOCATED(exc%pw_w)) THEN
ALLOCATE ( e_xc(SIZE(rho,1),1) ); e_xc=0.0
#ifdef CPP_LIBXC
IF(xcpot%kinED%set) THEN
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, xcpot%kinED%is, mt_call=.False.)
IF(kinED%set) THEN
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, kinED%is, mt_call=.False.)
ELSE
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, mt_call=.False.)
ENDIF
......
......@@ -24,7 +24,7 @@
CONTAINS
SUBROUTINE vmt_xc(mpi,sphhar,atoms,&
den,xcpot,input,sym,EnergyDen,noco,vTot,vx,exc)
den,xcpot,input,sym,EnergyDen,kinED,noco,vTot,vx,exc)
#include"cpp_double.h"
use m_libxc_postprocess_gga
USE m_mt_tofrom_grid
......@@ -34,7 +34,7 @@
USE m_juDFT_string
IMPLICIT NONE
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
......@@ -43,6 +43,7 @@
TYPE(t_potden),INTENT(IN) :: den,EnergyDen
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden),INTENT(INOUT) :: vTot,vx,exc
TYPE(t_kinED),INTENT(IN) :: kinED
#ifdef CPP_MPI
include "mpif.h"
#endif
......@@ -104,7 +105,6 @@
#endif
loc_n = 0
!TODO: MetaGGA
!call xcpot%kinED%alloc_mt(nsp*atoms%jmtd,input%jspins, n_start, atoms%ntype, n_stride)
DO n = n_start,atoms%ntype,n_stride
ALLOCATE(ch(nsp*atoms%jri(n),input%jspins),v_x(nsp*atoms%jri(n),input%jspins),&
v_xc(nsp*atoms%jri(n),input%jspins),e_xc(nsp*atoms%jri(n),input%jspins))
......@@ -116,9 +116,9 @@
!
! calculate the ex.-cor. potential
#ifdef CPP_LIBXC
if(perform_MetaGGA .and. xcpot%kinED%set) then
if(perform_MetaGGA .and. kinED%set) then
CALL xcpot%get_vxc(input%jspins,ch,v_xc&
, v_x,grad, kinED_KS=xcpot%kinED%mt(:,:,loc_n))
, v_x,grad, kinED_KS=kinED%mt(:,:,loc_n))
else
CALL xcpot%get_vxc(input%jspins,ch,v_xc&
, v_x,grad)
......@@ -154,10 +154,10 @@
! calculate the ex.-cor energy density
!
#ifdef CPP_LIBXC
IF(perform_MetaGGA .and. xcpot%kinED%set) THEN
IF(perform_MetaGGA .and. kinED%set) THEN
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),&
e_xc(:nsp*atoms%jri(n),1),grad, &
kinED_KS=xcpot%kinED%mt(:,:,loc_n), mt_call=.True.)
kinED_KS=kinED%mt(:,:,loc_n), mt_call=.True.)
ELSE
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),&
e_xc(:nsp*atoms%jri(n),1),grad, mt_call=.True.)
......
......@@ -13,7 +13,32 @@ MODULE m_metagga
REAL, ALLOCATABLE :: is(:,:), mt(:,:)
end type t_RS_potden
TYPE t_kinED
logical :: set=.false.
real, allocatable :: is(:,:) ! (nsp*jmtd, jspins)
real, allocatable :: mt(:,:,:) ! (nsp*jmtd, jspins, local num of types)
contains
procedure :: alloc_mt => kED_alloc_mt
END TYPE t_kinED
CONTAINS
SUBROUTINE kED_alloc_mt(kED,nsp_x_jmtd, jspins, n_start, n_types, n_stride)
IMPLICIT NONE
class(t_kinED), intent(inout) :: kED
integer, intent(in) :: nsp_x_jmtd, jspins, n_start, n_types, n_stride
integer :: cnt, n
if(.not. allocated(kED%mt)) then
cnt = 0
do n = n_start,n_types,n_stride
cnt = cnt + 1
enddo
allocate(kED%mt(nsp_x_jmtd, jspins, cnt), source=0.0)
endif
END SUBROUTINE kED_alloc_mt
SUBROUTINE calc_kinEnergyDen_pw(EnergyDen_rs, vTot_rs, den_rs, kinEnergyDen_RS)
USE m_juDFT_stop
!use m_cdngen
......@@ -210,24 +235,38 @@ CONTAINS
endif
end subroutine undo_vgen_finalize
subroutine set_kinED(mpi, sphhar, atoms, sym, core_den, val_den, xcpot, &
input, noco, stars, cell, den, EnergyDen, vTot)
subroutine set_kinED(mpi, sphhar, atoms, sym, xcpot, &
input, noco, stars, cell, den, EnergyDen, vTot,kinED)
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_sym), INTENT(IN) :: sym
TYPE(t_potden),INTENT(IN) :: core_den, val_den
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
CLASS(t_xcpot),INTENT(OUT) :: 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
TYPE(t_kinED),INTENT(OUT) :: kinED
TYPE(t_potden) :: vTot_corrected
LOGICAL :: perform_MetaGGA
TYPE(t_potden) :: core_den, val_den
real :: rdum
logical :: ldum
perform_MetaGGA = ALLOCATED(EnergyDen%mt) &
.AND. (xcpot%exc_is_MetaGGA() .or. xcpot%vx_is_MetaGGA())
if(.not.perform_MetaGGA) return
#ifdef CPP_LIBXC
call readDensity(stars,noco,vacuum,atoms,cell,sphhar,input,sym,oneD,&
CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
0,-1.0,rdum,ldum,core_den,'cdnc')
call val_den%subPotDen(den,core_den)
call vTot_corrected%copyPotDen(vTot)
call undo_vgen_finalize(vTot_corrected, atoms, noco, stars)
......@@ -237,17 +276,18 @@ CONTAINS
#endif
end subroutine set_kinED
#ifdef CPP_LIBXC
subroutine set_kinED_is(xcpot, input, noco, stars, sym, cell, den, EnergyDen, vTot)
subroutine set_kinED_is(xcpot, input, noco, stars, sym, cell, den, EnergyDen, vTot,kinED)
use m_types
use m_pw_tofrom_grid
implicit none
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
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_sym), INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_potden),INTENT(IN) :: den, EnergyDen, vTot
TYPE(t_kinED),INTENT(INOUT) :: kinED
!local arrays
REAL, ALLOCATABLE :: den_rs(:,:), ED_rs(:,:), vTot_rs(:,:)
......@@ -264,13 +304,13 @@ CONTAINS
CALL finish_pw_grid()
call calc_kinEnergyDen_pw(ED_rs, vTot_rs, den_rs, xcpot%kinED%is)
call calc_kinEnergyDen_pw(ED_rs, vTot_rs, den_rs, kinED%is)
!xcpot%kinED%is = ED_RS - vTot_RS * den_RS
xcpot%kinED%set = .True.
kinED%set = .True.
end subroutine set_kinED_is
subroutine set_kinED_mt(mpi, sphhar, atoms, sym, noco,core_den, val_den, &
xcpot, EnergyDen, input, vTot)
xcpot, EnergyDen, input, vTot,kinED)
use m_types
use m_mt_tofrom_grid
implicit none
......@@ -280,9 +320,9 @@ CONTAINS
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_potden),INTENT(IN) :: core_den, val_den, EnergyDen, vTot
CLASS(t_xcpot),INTENT(INOUT) :: xcpot
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_kinED),INTENT(INOUT) :: kinED
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(:,:)
......@@ -304,7 +344,7 @@ CONTAINS
allocate(core_den_rs, mold=ED_rs)
allocate(val_den_rs, mold=ED_rs)
call xcpot%kinED%alloc_mt(atoms%nsp()*atoms%jmtd, input%jspins, &
call 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
......@@ -335,10 +375,10 @@ CONTAINS
val_den%mt(:,0:,n,:), n,noco, tmp_grad, val_den_rs)
call calc_kinEnergyDen_mt(ED_RS, vTot_rs, vTot0_rs, core_den_rs, val_den_rs, &
xcpot%kinED%mt(:,:,loc_n))
kinED%mt(:,:,loc_n))
!xcpot%kinED%mt(:,:,loc_n) = ED_RS - (vTot0_rs * core_den_rs + vTot_rs * val_den_rs)
enddo
xcpot%kinED%set = .True.
kinED%set = .True.
CALL finish_mt_grid()
end subroutine set_kinED_mt
#endif
......
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