Commit c0ce42aa authored by Matthias Redies's avatar Matthias Redies

change mt_grid interface to match that of pw_grid

parent 19c9dac3
...@@ -20,7 +20,8 @@ MODULE m_types_xcpot ...@@ -20,7 +20,8 @@ MODULE m_types_xcpot
REAL :: gmaxxc REAL :: gmaxxc
CONTAINS CONTAINS
PROCEDURE :: is_gga=>xcpot_is_gga 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 :: is_hybrid=>xcpot_is_hybrid
PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight PROCEDURE :: get_exchange_weight=>xcpot_get_exchange_weight
PROCEDURE :: get_vxc=>xcpot_get_vxc PROCEDURE :: get_vxc=>xcpot_get_vxc
...@@ -59,6 +60,14 @@ CONTAINS ...@@ -59,6 +60,14 @@ CONTAINS
xcpot_is_MetaGGA=.false. xcpot_is_MetaGGA=.false.
END FUNCTION xcpot_is_MetaGGA 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) LOGICAL FUNCTION xcpot_is_hybrid(xcpot)
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN):: xcpot CLASS(t_xcpot),INTENT(IN):: xcpot
......
...@@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid ...@@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid
REAL, ALLOCATABLE :: wt(:),rx(:,:),thet(:) REAL, ALLOCATABLE :: wt(:),rx(:,:),thet(:)
PUBLIC :: init_mt_grid,mt_to_grid,mt_from_grid,finish_mt_grid PUBLIC :: init_mt_grid,mt_to_grid,mt_from_grid,finish_mt_grid
CONTAINS 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_gaussp
USE m_lhglptg USE m_lhglptg
USE m_lhglpts USE m_lhglpts
...@@ -23,7 +23,6 @@ CONTAINS ...@@ -23,7 +23,6 @@ CONTAINS
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
CLASS(t_xcpot),INTENT(IN) :: xcpot CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
LOGICAL,INTENT(IN) :: l_grad
! generate nspd points on a sherical shell with radius 1.0 ! generate nspd points on a sherical shell with radius 1.0
! angular mesh equidistant in phi, ! angular mesh equidistant in phi,
...@@ -32,29 +31,30 @@ CONTAINS ...@@ -32,29 +31,30 @@ CONTAINS
CALL gaussp(atoms%lmaxd, rx,wt) CALL gaussp(atoms%lmaxd, rx,wt)
! generate the lattice harmonics on the angular mesh ! generate the lattice harmonics on the angular mesh
ALLOCATE ( ylh(nsp,0:sphhar%nlhd,sphhar%ntypsd)) ALLOCATE ( ylh(nsp,0:sphhar%nlhd,sphhar%ntypsd))
IF (l_grad) ALLOCATE(ylht,MOLD=ylh ) IF (xcpot%needs_grad()) THEN
IF (l_grad) ALLOCATE(ylhtt,MOLD=ylh ) ALLOCATE(ylht,MOLD=ylh )
IF (l_grad) ALLOCATE(ylhf,MOLD=ylh ) ALLOCATE(ylhtt,MOLD=ylh )
IF (l_grad) ALLOCATE(ylhff,MOLD=ylh ) ALLOCATE(ylhf,MOLD=ylh )
IF (l_grad) ALLOCATE(ylhtf,MOLD=ylh ) ALLOCATE(ylhff,MOLD=ylh )
ALLOCATE(ylhtf,MOLD=ylh )
IF (l_grad) THEN
CALL lhglptg(sphhar,atoms,rx,nsp,xcpot,sym,& CALL lhglptg(sphhar,atoms,rx,nsp,xcpot,sym,&
ylh,thet,ylht,ylhtt,ylhf,ylhff,ylhtf) ylh,thet,ylht,ylhtt,ylhf,ylhff,ylhtf)
ELSE ELSE
CALL lhglpts( sphhar,atoms, rx,nsp, sym, ylh) CALL lhglpts( sphhar,atoms, rx,nsp, sym, ylh)
END IF END IF
END SUBROUTINE init_mt_grid 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_grdchlh
USE m_mkgylm USE m_mkgylm
IMPLICIT NONE IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
REAL,INTENT(IN) :: den_mt(:,0:,:) REAL,INTENT(IN) :: den_mt(:,0:,:)
INTEGER,INTENT(IN) :: n,jspins,nsp INTEGER,INTENT(IN) :: n,jspins,nsp
LOGICAL,INTENT(IN) :: l_grad
REAL,INTENT(OUT),OPTIONAL :: ch(:,:) REAL,INTENT(OUT),OPTIONAL :: ch(:,:)
TYPE(t_gradients),INTENT(INOUT):: grad TYPE(t_gradients),INTENT(INOUT):: grad
...@@ -68,7 +68,7 @@ CONTAINS ...@@ -68,7 +68,7 @@ CONTAINS
ALLOCATE ( chlh(atoms%jmtd,0:sphhar%nlhd,jspins)) ALLOCATE ( chlh(atoms%jmtd,0:sphhar%nlhd,jspins))
ALLOCATE ( ch_tmp(nsp,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),& 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),& chdtt(nsp,jspins),chdff(nsp,jspins),chdtf(nsp,jspins),chdrt(nsp,jspins),&
chdrf(nsp,jspins) ) chdrf(nsp,jspins) )
...@@ -87,7 +87,7 @@ CONTAINS ...@@ -87,7 +87,7 @@ CONTAINS
DO jr = 1,atoms%jri(n) DO jr = 1,atoms%jri(n)
chlh(jr,lh,js) = den_mt(jr,lh,js)/(atoms%rmsh(jr,n)*atoms%rmsh(jr,n)) chlh(jr,lh,js) = den_mt(jr,lh,js)/(atoms%rmsh(jr,n)*atoms%rmsh(jr,n))
ENDDO 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)) chlh(1,lh,js),ndvgrd, chlhdr(1,lh,js),chlhdrr(1,lh,js))
ENDDO ! js ENDDO ! js
...@@ -105,7 +105,7 @@ CONTAINS ...@@ -105,7 +105,7 @@ CONTAINS
ENDDO ENDDO
ENDDO ENDDO
ENDDO ENDDO
IF (l_grad) THEN IF (xcpot%needs_grad()) THEN
chdr(:,:) = 0.0 ! d(ch)/dr chdr(:,:) = 0.0 ! d(ch)/dr
chdt(:,:) = 0.0 ! d(ch)/dtheta chdt(:,:) = 0.0 ! d(ch)/dtheta
chdf(:,:) = 0.0 ! d(ch)/dfai chdf(:,:) = 0.0 ! d(ch)/dfai
......
...@@ -81,7 +81,7 @@ CONTAINS ...@@ -81,7 +81,7 @@ CONTAINS
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins)) ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad) 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 #ifdef CPP_MPI
...@@ -98,7 +98,7 @@ CONTAINS ...@@ -98,7 +98,7 @@ CONTAINS
#endif #endif
DO n = n_start,atoms%ntype,n_stride 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 ! calculate the ex.-cor. potential
CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc,v_x,grad) CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc,v_x,grad)
......
...@@ -33,7 +33,7 @@ CONTAINS ...@@ -33,7 +33,7 @@ CONTAINS
vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2 vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
ENDDO ENDDO
ALLOCATE(grad_sigma%gr(3,nsp,n_sigma)) 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) CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_sigma,v_xc)
END SUBROUTINE libxc_postprocess_gga_mt END SUBROUTINE libxc_postprocess_gga_mt
......
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