Commit 1018338f authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'xc-pot-refactor' into 'develop'

Merge libxc branch as GGA seems to be approximately working...

See merge request fleur/fleur!9
parents 295f78fc c941f55d
......@@ -82,6 +82,7 @@
! arltv(i) : length of reciprical lattice vector along
! direction (i)
!
IF (.NOT.xcpot%is_gga()) xcpot%gmaxxc=stars%gmax
WRITE (6,'('' gmaxxc should be: 2*kmax <= gmaxxc <= gmax '')')
IF ( abs( xcpot%gmaxxc - stars%gmax ) .le. 10.0**(-6) ) THEN
WRITE (6,'('' concerning memory, you may want to choose'',&
......
......@@ -20,7 +20,7 @@ CONTAINS
!! TE_EXC : charge density-ex-corr.energy density integral
SUBROUTINE vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,results,noco,den,vTot,vXC,vCoul)
obsolete,cell,oneD,sliceplot,mpi,results,noco,den,vTot,vx,vCoul)
USE m_rotate_int_den_to_local
USE m_bfield
......@@ -33,6 +33,7 @@ CONTAINS
#endif
IMPLICIT NONE
TYPE(t_results), INTENT(INOUT) :: results
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_hybrid), INTENT(IN) :: hybrid
......@@ -51,17 +52,18 @@ CONTAINS
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_potden), INTENT(INOUT) :: den
TYPE(t_potden), INTENT(INOUT) :: vTot,vXC,vCoul
TYPE(t_potden), INTENT(INOUT) :: vTot,vx,vCoul
TYPE(t_potden) :: workden,denRot
if (mpi%irank==0) WRITE (6,FMT=8000)
8000 FORMAT (/,/,t10,' p o t e n t i a l g e n e r a t o r',/)
CALL vTot%resetPotDen()
CALL vCoul%resetPotDen()
CALL vXC%resetPotDen()
ALLOCATE(vXC%pw_w,vTot%pw_w,mold=vTot%pw)
CALL vx%resetPotDen()
ALLOCATE(vx%pw_w,vTot%pw_w,mold=vTot%pw)
ALLOCATE(vCoul%pw_w(SIZE(den%pw,1),1))
CALL workDen%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,0)
......@@ -69,8 +71,10 @@ CONTAINS
!sum up both spins in den into workden
CALL den%sum_both_spin(workden)
CALL vgen_coulomb(1,mpi,dimension,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,workden,vCoul,results)
CALL vCoul%copy_both_spin(vTot)
IF (noco%l_noco) THEN
......@@ -79,19 +83,21 @@ CONTAINS
CALL rotate_int_den_to_local(dimension,sym,stars,atoms,sphhar,vacuum,cell,input,noco,oneD,denRot)
ENDIF
CALL vgen_xcpot(hybrid,input,xcpot,dimension,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,vTot,vXC,results)
obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,vTot,vx,results)
!ToDo, check if this is needed for more potentials as well...
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,vTot,denRot)
DEALLOCATE(vcoul%pw_w,vXC%pw_w)
DEALLOCATE(vcoul%pw_w,vx%pw_w)
CALL bfield(input,noco,atoms,field,vTot)
#ifdef CPP_MPI
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vTot)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vCoul)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vXC)
CALL mpi_bc_potden(mpi,stars,sphhar,atoms,input,vacuum,oneD,noco,vx)
#endif
END SUBROUTINE vgen
......
......@@ -39,6 +39,9 @@ MODULE m_types_xcpot
REAL,ALLOCATABLE :: gggrd(:),grgru(:),grgrd(:)
!These are the contracted Gradients used in libxc
REAL,ALLOCATABLE :: sigma(:,:)
REAL,ALLOCATABLE :: vsigma(:,:)
REAL,ALLOCATABLE :: gr(:,:,:)
REAL,ALLOCATABLE :: laplace(:,:)
END TYPE t_gradients
CONTAINS
......@@ -63,15 +66,14 @@ CONTAINS
a_ex=-1
END FUNCTION xcpot_get_exchange_weight
SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh,vxc,vx,grad,drdsigma)
SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh,vxc,vx,grad)
CLASS(t_xcpot),INTENT(IN) :: xcpot
INTEGER, INTENT (IN) :: jspins
!--> charge density
REAL,INTENT (IN) :: rh(:,:)
!---> xc potential
REAL, INTENT (OUT) :: vxc (:,:),vx(:,:)
TYPE(t_gradients),OPTIONAL,INTENT(IN)::grad
REAL,ALLOCATABLE,OPTIONAL,INTENT(OUT)::drdsigma(:)
TYPE(t_gradients),OPTIONAL,INTENT(INOUT)::grad
END SUBROUTINE xcpot_get_vxc
......@@ -87,8 +89,14 @@ CONTAINS
SUBROUTINE xcpot_alloc_gradients(ngrid,jspins,grad)
INTEGER, INTENT (IN) :: jspins,ngrid
TYPE(t_gradients),INTENT(OUT):: grad
TYPE(t_gradients),INTENT(INOUT):: grad
IF (allocated(grad%agrt)) THEN
DEALLOCATE(grad%agrt,grad%agru,grad%agrd)
DEALLOCATE(grad%g2ru,grad%g2rd,grad%gggrt)
DEALLOCATE(grad%gggru,grad%gzgr,grad%g2rt)
DEALLOCATE(grad%gggrd,grad%grgru,grad%grgrd)
ENDIF
!For the in-build xc-pots
ALLOCATE(grad%agrt(ngrid),grad%agru(ngrid),grad%agrd(ngrid))
ALLOCATE(grad%g2ru(ngrid),grad%g2rd(ngrid),grad%gggrt(ngrid))
......
......@@ -135,7 +135,7 @@ CONTAINS
END FUNCTION xcpot_get_exchange_weight
!***********************************************************************
SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh, vxc,vx, grad,drdsigma)
SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh, vxc,vx, grad)
!***********************************************************************
!
USE m_xcxal, ONLY : vxcxal
......@@ -164,8 +164,7 @@ CONTAINS
REAL, INTENT (OUT) :: vxc(:,:)
! optional arguments for GGA
TYPE(t_gradients),INTENT(IN),OPTIONAL::grad
REAL,ALLOCATABLE,OPTIONAL,INTENT(OUT)::drdsigma(:) !This will not be allocated
TYPE(t_gradients),INTENT(INOUT),OPTIONAL::grad
!c
!c ---> local scalars
INTEGER :: ngrid
......
......@@ -45,6 +45,14 @@ CONTAINS
xcpot%func_id_x=id_x
xcpot%func_id_c=id_c
if(xcpot%func_id_x == 0 .or. xcpot%func_id_c == 0) then
CALL judft_error("LibXC exchange- and correlation-function indicies need to be set"&
,hint='Try this: ' // ACHAR(10) //&
'<xcFunctional name="libxc" relativisticCorrections="F">' // ACHAR(10) //&
' <libXC exchange="1" correlation="1" /> ' // ACHAR(10) //&
'</xcFunctional> ')
endif
IF (jspins==1) THEN
CALL xc_f03_func_init(xcpot%xc_func_x, xcpot%func_id_x, XC_UNPOLARIZED)
IF (xcpot%func_id_c>0) CALL xc_f03_func_init(xcpot%xc_func_c, xcpot%func_id_c, XC_UNPOLARIZED)
......@@ -95,7 +103,7 @@ CONTAINS
END FUNCTION xcpot_get_exchange_weight
!***********************************************************************
SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh, vxc,vx, grad,drdsigma)
SUBROUTINE xcpot_get_vxc(xcpot,jspins,rh, vxc,vx, grad)
!***********************************************************************
IMPLICIT NONE
CLASS(t_xcpot_libxc),INTENT(IN) :: xcpot
......@@ -104,23 +112,23 @@ CONTAINS
REAL, INTENT (OUT) :: vx (:,:) !points,spin
REAL, INTENT (OUT ) :: vxc(:,:) !
! optional arguments for GGA
TYPE(t_gradients),OPTIONAL,INTENT(IN)::grad
REAL,ALLOCATABLE,OPTIONAL,INTENT(OUT)::drdsigma(:)
TYPE(t_gradients),OPTIONAL,INTENT(INOUT)::grad
#ifdef CPP_LIBXC
REAL,ALLOCATABLE::vxc_tmp(:,:),vx_tmp(:,:),vsigma(:)
REAL,ALLOCATABLE::vxc_tmp(:,:),vx_tmp(:,:),vsigma(:,:)
!libxc uses the spin as a first index, hence we have to transpose....
ALLOCATE(vxc_tmp(SIZE(vxc,2),SIZE(vxc,1)));vxc_tmp=0.0
ALLOCATE(vx_tmp(SIZE(vx,2),SIZE(vx,1)));vx_tmp=0.0
IF (xcpot%is_gga()) THEN
CALL judft_error("libxc GGA not implemented yet")
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
ALLOCATE(drdsigma(SIZE(grad%sigma)))
CALL xc_f03_gga_vxc(xcpot%xc_func_x, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,vx_tmp,drdsigma)
ALLOCATE(vsigma,mold=grad%vsigma)
!where(abs(grad%sigma)<1E-9) grad%sigma=1E-9
CALL xc_f03_gga_vxc(xcpot%xc_func_x, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,vx_tmp,vsigma)
IF (xcpot%func_id_c>0) THEN
ALLOCATE(vsigma(SIZE(grad%sigma)))
CALL xc_f03_gga_vxc(xcpot%xc_func_c, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,vxc_tmp,vsigma)
drdsigma=drdsigma+vsigma
CALL xc_f03_gga_vxc(xcpot%xc_func_c, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,vxc_tmp,grad%vsigma)
grad%vsigma=grad%vsigma+vsigma
vxc_tmp=vxc_tmp+vx_tmp
ELSE
vxc_tmp=vx_tmp
ENDIF
ELSE !LDA potentials
CALL xc_f03_lda_vxc(xcpot%xc_func_x, SIZE(rh,1), TRANSPOSE(rh), vx_tmp)
......@@ -169,9 +177,14 @@ CONTAINS
SUBROUTINE xcpot_alloc_gradients(ngrid,jspins,grad)
INTEGER, INTENT (IN) :: jspins,ngrid
TYPE(t_gradients),INTENT(OUT):: grad
TYPE(t_gradients),INTENT(INOUT):: grad
!For libxc we only need the sigma array...
IF (ALLOCATED(grad%sigma)) DEALLOCATE(grad%sigma,grad%gr,grad%laplace,grad%vsigma)
ALLOCATE(grad%sigma(MERGE(1,3,jspins==1),ngrid))
ALLOCATE(grad%gr(3,ngrid,jspins))
ALLOCATE(grad%laplace(ngrid,jspins))
ALLOCATE(grad%vsigma,mold=grad%sigma)
END SUBROUTINE xcpot_alloc_gradients
......
......@@ -2,8 +2,6 @@ set(fleur_F77 ${fleur_F77}
vgen/dylm3.f
vgen/fft3dxc.f
vgen/grdrsvac.f
vgen/mkgxyz3.f
vgen/mkgylm.f
vgen/mkgz.f
vgen/modcyli.f
vgen/modcylk.f
......@@ -17,8 +15,11 @@ vgen/visp5_z.f
)
set(fleur_F90 ${fleur_F90}
vgen/b_field.F90
vgen/mkgylm.f90
vgen/mkgxyz3.f90
vgen/convol.f90
vgen/grdrsis.f90
vgen/mt_tofrom_grid.F90
vgen/int_nv.F90
vgen/lhglptg.f90
vgen/lhglpts.f90
......@@ -32,12 +33,11 @@ vgen/prp_xcfft_map.f90
vgen/psqpw.F90
vgen/rotate_int_den_to_local.F90
vgen/vintcz.f90
vgen/visxc.f90
vgen/visxcg.f90
vgen/vis_xc.F90
vgen/pw_tofrom_grid.F90
vgen/vmatgen.f90
vgen/vmts.F90
vgen/vmtxc.f90
vgen/vmtxcg.F90
vgen/vmt_xc.F90
vgen/vvac.f90
vgen/vvacis.f90
vgen/vvacxc.f90
......
MODULE m_grdrsis
use m_juDFT
!.....-----------------------------------------------------------------
! evaluates gradient of an interstitial function in real space
!
! based on 'rhzgrd' coded by t.asada. june,1995.
!.....-----------------------------------------------------------------
CONTAINS
SUBROUTINE grdrsis(&
& ro,cell,xmax1,xmax2,xmax3,obsolete,&
& dro)
!.....-----------------------------------------------------------------
! input:
! ro(0:xmax1*xmax2*xmax3-1)
! any quantity stored in usual interst. box (xmax1 x xmax2 x xmax3)
! bmat
! bravais matrix of reciprocal space
! ndvgrd
! number of ponts used when calculating derivative (3 <= ndvgrd <= 6)
!
! output:
! dro(0:xmax1*xmax2*xmax3-1,3)
! gradient of ro in non-internal coordinates
!
!.....-----------------------------------------------------------------
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_grdrsis
USE m_juDFT
PRIVATE
INTEGER,PARAMETER :: ndvgrd=6 ! this should be consistent across GGA derivative routines
PUBLIC grdrsis
!.....-----------------------------------------------------------------
! evaluates gradient of an interstitial function in real space
!
! based on 'rhzgrd' coded by t.asada. june,1995.
!.....-----------------------------------------------------------------
CONTAINS
SUBROUTINE grdrsis(ro,cell,xmax1,xmax2,xmax3, dro)
!.....-----------------------------------------------------------------
! input:
! ro(0:xmax1*xmax2*xmax3-1)
! any quantity stored in usual interst. box (xmax1 x xmax2 x xmax3)
! bmat
! bravais matrix of reciprocal space
! ndvgrd
! number of ponts used when calculating derivative (3 <= ndvgrd <= 6)
!
! output:
! dro(0:xmax1*xmax2*xmax3-1,3)
! gradient of ro in non-internal coordinates
!
!.....-----------------------------------------------------------------
USE m_constants
USE m_types
IMPLICIT NONE
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_cell),INTENT(IN) :: cell
! ..
! .. Scalar arguments ..
! ..
! .. Scalar arguments ..
INTEGER, INTENT (IN) :: xmax1,xmax2,xmax3
! ..
! .. Array arguments ..
! ..
! .. Array arguments ..
REAL, INTENT(IN) :: ro(0:xmax1*xmax2*xmax3-1)
! ..
! .. Array output ..
! ..
! .. Array output ..
REAL, INTENT(OUT) :: dro(0:xmax1*xmax2*xmax3-1,3)
! ..
! .. Locals ..
! ..
! .. Locals ..
INTEGER :: xmax(3)
INTEGER :: direction,xyz(3),x1,x2,x3,i,ii(-3:2)
REAL :: dx,drointern(0:xmax1*xmax2*xmax3-1,3)
......@@ -52,7 +57,7 @@
CALL juDFT_error("grid to small",calledby="grdrsis")
END IF
END DO
IF ( (obsolete%ndvgrd < 3) .or. (obsolete%ndvgrd > 6) ) THEN
IF ( (ndvgrd < 3) .or. (ndvgrd > 6) ) THEN
CALL juDFT_error("ndvgrd notin [3,6]",calledby="grdrsis")
ENDIF
......@@ -81,19 +86,19 @@
ii(i)= xyz(3)*xmax(1)*xmax(2) + xyz(2)*xmax(1) + xyz(1)
END DO
IF (obsolete%ndvgrd.EQ.3) THEN
IF (ndvgrd.EQ.3) THEN
drointern(ii(0),direction)= &
& df3( ro(ii(-1)), &
& ro(ii(0)),ro(ii(1)), dx)
ELSEIF (obsolete%ndvgrd.EQ.4) THEN
ELSEIF (ndvgrd.EQ.4) THEN
drointern(ii(0),direction)= &
& df4( ro(ii(-1)),&
& ro(ii(0)),ro(ii(1)),ro(ii(2)), dx)
ELSEIF (obsolete%ndvgrd.EQ.5) THEN
ELSEIF (ndvgrd.EQ.5) THEN
drointern(ii(0),direction)= &
& df5( ro(ii(-2)),ro(ii(-1)),&
& ro(ii(0)),ro(ii(1)),ro(ii(2)), dx)
ELSEIF (obsolete%ndvgrd.EQ.6) THEN
ELSEIF (ndvgrd.EQ.6) THEN
drointern(ii(0),direction)= &
& df6( ro(ii(-3)),ro(ii(-2)),ro(ii(-1)),&
& ro(ii(0)),ro(ii(1)),ro(ii(2)), dx)
......@@ -118,9 +123,9 @@
END DO
END SUBROUTINE grdrsis
!--------------------------------------------------------------------
! Functions: formulae for 1st deriv.:
!
!--------------------------------------------------------------------
! Functions: formulae for 1st deriv.:
!
REAL FUNCTION df3(g1,f0,f1,d) ! three point formula
REAL g1,f0,f1,d
df3 = (-1*g1-0*f0+f1)/ (2*d)
......@@ -141,5 +146,5 @@
df6 = (-4*g3+30*g2-120*g1+40*f0+60*f1-6*f2)/ (120*d)
END FUNCTION df6
!----------------------------------------------------------------------
END MODULE m_grdrsis
!----------------------------------------------------------------------
END MODULE m_grdrsis
......@@ -3,60 +3,70 @@
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_mkgxyz3
c.....------------------------------------------------------------------
c by use of cartesian x,y,z components of charge density gradients,
c make the quantities
cc agrt,agru,agrd,g2rt,g2ru,g2rd,gggrt,gggru,gggrd,gzgr
cc used to calculate gradient contribution to xc potential and
cc energy.
c.....------------------------------------------------------------------
CONTAINS
SUBROUTINE mkgxyz3(
> ndm,jsdm,ng3,jspins,vl,
> dvx,dvy,dvz,dvxx,dvyy,dvzz,dvyz,dvzx,dvxy,
< grad)
MODULE m_mkgxyz3
!.....------------------------------------------------------------------
!c by use of cartesian x,y,z components of charge density gradients,
!c make the quantities
!cc agrt,agru,agrd,g2rt,g2ru,g2rd,gggrt,gggru,gggrd,gzgr
!cc used to calculate gradient contribution to xc potential and
!cc energy.
!c.....------------------------------------------------------------------
CONTAINS
SUBROUTINE mkgxyz3(vl,dvx,dvy,dvz,dvxx,dvyy,dvzz,dvyz,dvzx,dvxy,grad)
USE m_types
IMPLICIT NONE
INTEGER, INTENT (IN) :: ndm,ng3,jsdm,jspins
REAL, INTENT (IN) :: vl(ndm,jsdm)
REAL, INTENT (IN) :: dvx(ndm,jsdm),dvy(ndm,jsdm),dvz(ndm,jsdm)
REAL, INTENT (IN) :: dvxx(ndm,jsdm),dvyy(ndm,jsdm),dvzz(ndm,jsdm)
REAL, INTENT (IN) :: dvyz(ndm,jsdm),dvzx(ndm,jsdm),dvxy(ndm,jsdm)
REAL, INTENT (IN) :: vl(:,:)
REAL, INTENT (IN) :: dvx(:,:),dvy(:,:),dvz(:,:)
REAL, INTENT (IN) :: dvxx(:,:),dvyy(:,:),dvzz(:,:)
REAL, INTENT (IN) :: dvyz(:,:),dvzx(:,:),dvxy(:,:)
TYPE(t_gradients),INTENT(INOUT)::grad
REAL vlt,dvxt,dvyt,dvzt,dvxxt,dvyyt,dvzzt,dvyzt,dvzxt,dvxyt,
& vlu,dvxu,dvyu,dvzu,dvxxu,dvyyu,dvzzu,dvyzu,dvzxu,dvxyu,
& vld,dvxd,dvyd,dvzd,dvxxd,dvyyd,dvzzd,dvyzd,dvzxd,dvxyd,
& dagrxt,dagrxd,dagrxu,dagryt,dagryd,dagryu,dagrzt,dagrzd,
+ dagrzu,dzdx,dzdy,dzdz,
+ sml
INTEGER i
REAL vlt,dvxt,dvyt,dvzt,dvxxt,dvyyt,dvzzt,dvyzt,dvzxt,dvxyt,&
vlu,dvxu,dvyu,dvzu,dvxxu,dvyyu,dvzzu,dvyzu,dvzxu,dvxyu,&
vld,dvxd,dvyd,dvzd,dvxxd,dvyyd,dvzzd,dvyzd,dvzxd,dvxyd,&
dagrxt,dagrxd,dagrxu,dagryt,dagryd,dagryu,dagrzt,dagrzd,&
dagrzu,dzdx,dzdy,dzdz,sml
INTEGER i,js,jspins,nsp
nsp=SIZE(dvx,1)
jspins=SIZE(dvx,2)
sml = 1.e-14
IF (ALLOCATED(grad%gr)) THEN
! Gradients for libxc
DO js=1,jspins
DO i=1,nsp
grad%gr(:,i,js)=(/dvx(i,js),dvy(i,js),dvz(i,js)/)
ENDDO
END DO
IF(ALLOCATED(grad%sigma)) THEN
!Use only contracted gradients for libxc
if (jspins==1) THEN
DO i=1,ng3
grad%sigma(1,i)=
+ dvx(i,1)*dvx(i,1)+dvy(i,1)*dvy(i,1)+dvz(i,1)*dvz(i,1)
!Use only contracted gradients for libxc
IF (jspins==1) THEN
DO i=1,nsp
grad%sigma(1,i)= dvx(i,1)*dvx(i,1)+dvy(i,1)*dvy(i,1)+dvz(i,1)*dvz(i,1)
ENDDO
ELSE
DO i=1,ng3
grad%sigma(1,i)=
+ dvx(i,1)*dvx(i,1)+dvy(i,1)*dvy(i,1)+dvz(i,1)*dvz(i,1)
grad%sigma(2,i)=
+ dvx(i,1)*dvx(i,2)+dvy(i,1)*dvy(i,2)+dvz(i,1)*dvz(i,2)
grad%sigma(3,i)=
+ dvx(i,2)*dvx(i,2)+dvy(i,2)*dvy(i,2)+dvz(i,2)*dvz(i,2)
DO i=1,nsp
grad%sigma(1,i)= dvx(i,1)*dvx(i,1)+dvy(i,1)*dvy(i,1)+dvz(i,1)*dvz(i,1)
grad%sigma(2,i)= dvx(i,1)*dvx(i,2)+dvy(i,1)*dvy(i,2)+dvz(i,1)*dvz(i,2)
grad%sigma(3,i)= dvx(i,2)*dvx(i,2)+dvy(i,2)*dvy(i,2)+dvz(i,2)*dvz(i,2)
ENDDO
ENDIF
END IF
IF(ALLOCATED(grad%laplace)) THEN
DO js=1,jspins
DO i=1,nsp
grad%laplace(i,js)= dvxx(i,js)+dvyy(i,js)+dvzz(i,js)
ENDDO
ENDDO
ENDIF
RETURN
ENDIF
DO i = 1,ndm
IF (ANY(SHAPE(vl).NE.SHAPE(dvx))) CALL judft_error("Gradients for internal GGA called with inconsistent sizes",hint="This is a bug")
DO i = 1,size(grad%agrt)
grad%agrt(i) = 0.0
grad%agru(i) = 0.0
grad%agrd(i) = 0.0
......@@ -71,7 +81,7 @@ c.....------------------------------------------------------------------
IF (jspins.eq.1) THEN
DO 10 i = 1,ng3
DO 10 i = 1,nsp
vlu=max(vl(i,1)/2,sml)
dvxu=dvx(i,1)/2
......@@ -108,7 +118,7 @@ c.....------------------------------------------------------------------
dvzxt = dvzxu + dvzxd
dvxyt = dvxyu + dvxyd
c agr: abs(grad(ro)), t,u,d for total, up and down.
! agr: abs(grad(ro)), t,u,d for total, up and down.
grad%agrt(i) = max(sqrt(dvxt**2+dvyt**2+dvzt**2),sml)
grad%agru(i) = max(sqrt(dvxu**2+dvyu**2+dvzu**2),sml)
......@@ -130,28 +140,28 @@ c agr: abs(grad(ro)), t,u,d for total, up and down.
grad%gggru(i) = dvxu*dagrxu + dvyu*dagryu + dvzu*dagrzu
grad%gggrd(i) = dvxd*dagrxd + dvyd*dagryd + dvzd*dagrzd
c dzdx=d(zeta)/dx,..
! dzdx=d(zeta)/dx,..
dzdx = (dvxu-dvxd)/vlt - (vlu-vld)*dvxt/vlt**2
dzdy = (dvyu-dvyd)/vlt - (vlu-vld)*dvyt/vlt**2
dzdz = (dvzu-dvzd)/vlt - (vlu-vld)*dvzt/vlt**2
c gzgr=grad(zeta)*grad(ro).
! gzgr=grad(zeta)*grad(ro).
grad%gzgr(i) = dzdx*dvxt + dzdy*dvyt + dzdz*dvzt
c g2r: grad(grad(ro))
! g2r: grad(grad(ro))
grad%g2rt(i) = dvxxt + dvyyt + dvzzt
grad%g2ru(i) = dvxxu + dvyyu + dvzzu
grad%g2rd(i) = dvxxd + dvyyd + dvzzd
10 ENDDO
10 ENDDO
ELSE
DO 20 i = 1,ng3
DO 20 i = 1,nsp
vlu = max(vl(i,1),sml)
dvxu=dvx(i,1)
......@@ -187,7 +197,7 @@ c g2r: grad(grad(ro))
dvzxt = dvzxu + dvzxd
dvxyt = dvxyu + dvxyd
c agr: abs(grad(ro)), t,u,d for total, up and down.
!c agr: abs(grad(ro)), t,u,d for total, up and down.
grad%agrt(i) = max(sqrt(dvxt**2+dvyt**2+dvzt**2),sml)
grad%agru(i) = max(sqrt(dvxu**2+dvyu**2+dvzu**2),sml)
......@@ -209,25 +219,25 @@ c agr: abs(grad(ro)), t,u,d for total, up and down.
grad%gggru(i) = dvxu*dagrxu + dvyu*dagryu + dvzu*dagrzu
grad%gggrd(i) = dvxd*dagrxd + dvyd*dagryd + dvzd*dagrzd
c dzdx=d(zeta)/dx,..
!c dzdx=d(zeta)/dx,..
dzdx = (dvxu-dvxd)/vlt - (vlu-vld)*dvxt/vlt**2
dzdy = (dvyu-dvyd)/vlt - (vlu-vld)*dvyt/vlt**2
dzdz = (dvzu-dvzd)/vlt - (vlu-vld)*dvzt/vlt**2
c gzgr=grad(zeta)*grad(ro).
!c gzgr=grad(zeta)*grad(ro).
grad%gzgr(i) = dzdx*dvxt + dzdy*dvyt + dzdz*dvzt
c g2r: grad(grad(ro))
!c g2r: grad(grad(ro))
grad%g2rt(i) = dvxxt + dvyyt + dvzzt
grad%g2ru(i) = dvxxu + dvyyu + dvzzu
grad%g2rd(i) = dvxxd + dvyyd + dvzzd
20 ENDDO
20 ENDDO
ENDIF
END SUBROUTINE mkgxyz3
END MODULE m_mkgxyz3
END MODULE m_mkgxyz3
This diff is collapsed.
This diff is collapsed.
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_mt_tofrom_grid
USE m_types
PRIVATE
REAL,PARAMETER :: d_15 = 1.e-15
INTEGER,PARAMETER :: ndvgrd=6 ! this should be consistent across GGA derivative routines
REAL, ALLOCATABLE :: ylh(:,:,:),ylht(:,:,:),ylhtt(:,:,:)
REAL, ALLOCATABLE :: ylhf(:,:,:),ylhff(:,:,:),ylhtf(:,:,:)
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)
USE m_gaussp
USE m_lhglptg
USE m_lhglpts