From c0ce42aa7e395ca9de6a6b1f6855929346c8cba3 Mon Sep 17 00:00:00 2001 From: Matthias Redies Date: Thu, 9 Aug 2018 16:17:16 +0200 Subject: [PATCH] change mt_grid interface to match that of pw_grid --- types/types_xcpot.F90 | 11 ++++++++++- vgen/mt_tofrom_grid.F90 | 32 ++++++++++++++++---------------- vgen/vmt_xc.F90 | 4 ++-- xc-pot/libxc_postprocess_gga.f90 | 2 +- 4 files changed, 29 insertions(+), 20 deletions(-) diff --git a/types/types_xcpot.F90 b/types/types_xcpot.F90 index 5d858f85..eb75ba00 100644 --- a/types/types_xcpot.F90 +++ b/types/types_xcpot.F90 @@ -20,7 +20,8 @@ MODULE m_types_xcpot REAL :: gmaxxc CONTAINS PROCEDURE :: is_gga=>xcpot_is_gga - procedure :: is_MetaGGA=>xcpot_is_MetaGGA + PROCEDURE :: is_MetaGGA=>xcpot_is_MetaGGA + PROCEDURE :: needs_grad=>xcpot_needs_grad PROCEDURE :: is_hybrid=>xcpot_is_hybrid PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight PROCEDURE :: get_vxc=>xcpot_get_vxc @@ -59,6 +60,14 @@ CONTAINS xcpot_is_MetaGGA=.false. END FUNCTION xcpot_is_MetaGGA + LOGICAL FUNCTION xcpot_needs_grad(xcpot) + IMPLICIT NONE + CLASS(t_xcpot),INTENT(IN):: xcpot + + xcpot_needs_grad= xcpot%is_gga() .or. xcpot%is_MetaGGA() + END FUNCTION xcpot_needs_grad + + LOGICAL FUNCTION xcpot_is_hybrid(xcpot) IMPLICIT NONE CLASS(t_xcpot),INTENT(IN):: xcpot diff --git a/vgen/mt_tofrom_grid.F90 b/vgen/mt_tofrom_grid.F90 index f07f2c4e..e5e4b9b1 100644 --- a/vgen/mt_tofrom_grid.F90 +++ b/vgen/mt_tofrom_grid.F90 @@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid REAL, ALLOCATABLE :: wt(:),rx(:,:),thet(:) PUBLIC :: init_mt_grid,mt_to_grid,mt_from_grid,finish_mt_grid CONTAINS - SUBROUTINE init_mt_grid(nsp,jspins,atoms,sphhar,xcpot,sym,l_grad) + SUBROUTINE init_mt_grid(nsp,jspins,atoms,sphhar,xcpot,sym) USE m_gaussp USE m_lhglptg USE m_lhglpts @@ -23,7 +23,6 @@ CONTAINS TYPE(t_sphhar),INTENT(IN) :: sphhar CLASS(t_xcpot),INTENT(IN) :: xcpot TYPE(t_sym),INTENT(IN) :: sym - LOGICAL,INTENT(IN) :: l_grad ! generate nspd points on a sherical shell with radius 1.0 ! angular mesh equidistant in phi, @@ -32,29 +31,30 @@ CONTAINS CALL gaussp(atoms%lmaxd, rx,wt) ! generate the lattice harmonics on the angular mesh ALLOCATE ( ylh(nsp,0:sphhar%nlhd,sphhar%ntypsd)) - IF (l_grad) ALLOCATE(ylht,MOLD=ylh ) - IF (l_grad) ALLOCATE(ylhtt,MOLD=ylh ) - IF (l_grad) ALLOCATE(ylhf,MOLD=ylh ) - IF (l_grad) ALLOCATE(ylhff,MOLD=ylh ) - IF (l_grad) ALLOCATE(ylhtf,MOLD=ylh ) - - IF (l_grad) THEN - CALL lhglptg(sphhar,atoms,rx,nsp,xcpot,sym,& - ylh,thet,ylht,ylhtt,ylhf,ylhff,ylhtf) + IF (xcpot%needs_grad()) THEN + ALLOCATE(ylht,MOLD=ylh ) + ALLOCATE(ylhtt,MOLD=ylh ) + ALLOCATE(ylhf,MOLD=ylh ) + ALLOCATE(ylhff,MOLD=ylh ) + ALLOCATE(ylhtf,MOLD=ylh ) + + CALL lhglptg(sphhar,atoms,rx,nsp,xcpot,sym,& + ylh,thet,ylht,ylhtt,ylhf,ylhff,ylhtf) ELSE CALL lhglpts( sphhar,atoms, rx,nsp, sym, ylh) END IF END SUBROUTINE init_mt_grid - SUBROUTINE mt_to_grid(atoms,sphhar,den_mt,nsp,jspins,n,l_grad,grad,ch) + SUBROUTINE mt_to_grid(xcpot,jspins,atoms,sphhar,den_mt,nsp,n,grad,ch) +! SUBROUTINE pw_to_grid(xcpot,jspins,l_noco,stars,cell,den_pw,grad,rho) USE m_grdchlh USE m_mkgylm IMPLICIT NONE + CLASS(t_xcpot),INTENT(IN) :: xcpot TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_sphhar),INTENT(IN) :: sphhar REAL,INTENT(IN) :: den_mt(:,0:,:) INTEGER,INTENT(IN) :: n,jspins,nsp - LOGICAL,INTENT(IN) :: l_grad REAL,INTENT(OUT),OPTIONAL :: ch(:,:) TYPE(t_gradients),INTENT(INOUT):: grad @@ -68,7 +68,7 @@ CONTAINS ALLOCATE ( chlh(atoms%jmtd,0:sphhar%nlhd,jspins)) ALLOCATE ( ch_tmp(nsp,jspins) ) - IF (l_grad) THEN + IF (xcpot%needs_grad()) THEN ALLOCATE(chdr(nsp,jspins),chdt(nsp,jspins),chdf(nsp,jspins),chdrr(nsp,jspins),& chdtt(nsp,jspins),chdff(nsp,jspins),chdtf(nsp,jspins),chdrt(nsp,jspins),& chdrf(nsp,jspins) ) @@ -87,7 +87,7 @@ CONTAINS DO jr = 1,atoms%jri(n) chlh(jr,lh,js) = den_mt(jr,lh,js)/(atoms%rmsh(jr,n)*atoms%rmsh(jr,n)) ENDDO - IF (l_grad) CALL grdchlh(1,1,atoms%jri(n),atoms%dx(n),atoms%rmsh(1,n),& + IF (xcpot%needs_grad()) CALL grdchlh(1,1,atoms%jri(n),atoms%dx(n),atoms%rmsh(1,n),& chlh(1,lh,js),ndvgrd, chlhdr(1,lh,js),chlhdrr(1,lh,js)) ENDDO ! js @@ -105,7 +105,7 @@ CONTAINS ENDDO ENDDO ENDDO - IF (l_grad) THEN + IF (xcpot%needs_grad()) THEN chdr(:,:) = 0.0 ! d(ch)/dr chdt(:,:) = 0.0 ! d(ch)/dtheta chdf(:,:) = 0.0 ! d(ch)/dfai diff --git a/vgen/vmt_xc.F90 b/vgen/vmt_xc.F90 index e7d57097..c1e7c22e 100644 --- a/vgen/vmt_xc.F90 +++ b/vgen/vmt_xc.F90 @@ -81,7 +81,7 @@ CONTAINS ALLOCATE(ch(nsp*atoms%jmtd,input%jspins)) IF (xcpot%is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad) - CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym,xcpot%is_gga()) + CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym) #ifdef CPP_MPI @@ -98,7 +98,7 @@ CONTAINS #endif DO n = n_start,atoms%ntype,n_stride - CALL mt_to_grid(atoms,sphhar,den%mt(:,0:,n,:),nsp,input%jspins,n,xcpot%is_gga(),grad,ch) + CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),nsp,n,grad,ch) ! ! calculate the ex.-cor. potential CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc,v_x,grad) diff --git a/xc-pot/libxc_postprocess_gga.f90 b/xc-pot/libxc_postprocess_gga.f90 index e8dc8155..1132d179 100644 --- a/xc-pot/libxc_postprocess_gga.f90 +++ b/xc-pot/libxc_postprocess_gga.f90 @@ -33,7 +33,7 @@ CONTAINS vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2 ENDDO ALLOCATE(grad_sigma%gr(3,nsp,n_sigma)) - CALL mt_to_grid(atoms,sphhar,vsigma_mt,nsp/atoms%jmtd,n_sigma,n,.TRUE.,grad=grad_sigma) + CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,nsp/atoms%jmtd,n,grad=grad_sigma) CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_sigma,v_xc) END SUBROUTINE libxc_postprocess_gga_mt -- GitLab