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,26 +52,29 @@ 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)
!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
......
......@@ -44,7 +44,15 @@ CONTAINS
xcpot%jspins=jspins
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
!
!.....-----------------------------------------------------------------
USE m_constants
USE m_types
IMPLICIT NONE
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_cell),INTENT(IN) :: cell
! ..
! .. Scalar arguments ..
INTEGER, INTENT (IN) :: xmax1,xmax2,xmax3
! ..
! .. Array arguments ..
REAL, INTENT(IN) :: ro(0:xmax1*xmax2*xmax3-1)
! ..
! .. Array output ..
REAL, INTENT(OUT) :: dro(0:xmax1*xmax2*xmax3-1,3)
! ..
! .. Locals ..
INTEGER :: xmax(3)
INTEGER :: direction,xyz(3),x1,x2,x3,i,ii(-3:2)
REAL :: dx,drointern(0:xmax1*xmax2*xmax3-1,3)
xmax(1)= xmax1
xmax(2)= xmax2
xmax(3)= xmax3
DO i=1,3
IF ( xmax(i) < 3 ) THEN
CALL juDFT_error("grid to small",calledby="grdrsis")
END IF
END DO
IF ( (obsolete%ndvgrd < 3) .or. (obsolete%ndvgrd > 6) ) THEN
CALL juDFT_error("ndvgrd notin [3,6]",calledby="grdrsis")
ENDIF
DO direction=1,3
dx= 1./REAL(xmax(direction))
DO x1=0,xmax(1)-1
!--------------------------------------------------------------------------------
! 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_cell),INTENT(IN) :: cell
! ..
! .. Scalar arguments ..
INTEGER, INTENT (IN) :: xmax1,xmax2,xmax3
! ..
! .. Array arguments ..
REAL, INTENT(IN) :: ro(0:xmax1*xmax2*xmax3-1)
! ..
! .. Array output ..
REAL, INTENT(OUT) :: dro(0:xmax1*xmax2*xmax3-1,3)
! ..
! .. Locals ..
INTEGER :: xmax(3)
INTEGER :: direction,xyz(3),x1,x2,x3,i,ii(-3:2)
REAL :: dx,drointern(0:xmax1*xmax2*xmax3-1,3)
xmax(1)= xmax1
xmax(2)= xmax2
xmax(3)= xmax3
DO i=1,3
IF ( xmax(i) < 3 ) THEN
CALL juDFT_error("grid to small",calledby="grdrsis")
END IF
END DO
IF ( (ndvgrd < 3) .or. (ndvgrd > 6) ) THEN
CALL juDFT_error("ndvgrd notin [3,6]",calledby="grdrsis")
ENDIF
DO direction=1,3
dx= 1./REAL(xmax(direction))
DO x1=0,xmax(1)-1
DO x2=0,xmax(2)-1
DO x3=0,xmax(3)-1
DO i= -3,2
xyz(1)= x1
xyz(2)= x2
xyz(3)= x3
xyz(direction)= xyz(direction)+i
! make use of periodic boundary cond. in interstitial:
IF ( xyz(direction) < 0 ) THEN
xyz(direction)= xyz(direction)+xmax(direction)
END IF
IF ( xyz(direction) >= xmax(direction) ) THEN
xyz(direction)= xyz(direction)-xmax(direction)
END IF
! find coordinates in 1-dim array ro:
ii(i)= xyz(3)*xmax(1)*xmax(2) + xyz(2)*xmax(1) + xyz(1)
END DO
IF (obsolete%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
drointern(ii(0),direction)= &
& df4( ro(ii(-1)),&
& ro(ii(0)),ro(ii(1)),ro(ii(2)), dx)
ELSEIF (obsolete%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
drointern(ii(0),direction)= &
& df6( ro(ii(-3)),ro(ii(-2)),ro(ii(-1)),&
& ro(ii(0)),ro(ii(1)),ro(ii(2)), dx)
ENDIF
END DO
DO x3=0,xmax(3)-1
DO i= -3,2
xyz(1)= x1
xyz(2)= x2
xyz(3)= x3
xyz(direction)= xyz(direction)+i
! make use of periodic boundary cond. in interstitial:
IF ( xyz(direction) < 0 ) THEN
xyz(direction)= xyz(direction)+xmax(direction)
END IF
IF ( xyz(direction) >= xmax(direction) ) THEN
xyz(direction)= xyz(direction)-xmax(direction)
END IF
! find coordinates in 1-dim array ro:
ii(i)= xyz(3)*xmax(1)*xmax(2) + xyz(2)*xmax(1) + xyz(1)
END DO
IF (ndvgrd.EQ.3) THEN
drointern(ii(0),direction)= &
& df3( ro(ii(-1)), &
& ro(ii(0)),ro(ii(1)), dx)
ELSEIF (ndvgrd.EQ.4) THEN
drointern(ii(0),direction)= &
& df4( ro(ii(-1)),&
& ro(ii(0)),ro(ii(1)),ro(ii(2)), dx)
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 (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)
ENDIF
END DO
END DO
END DO
END DO
END DO
END DO
DO i=0,xmax(1)*xmax(2)*xmax(3)-1
DO direction=1,3
DO i=0,xmax(1)*xmax(2)*xmax(3)-1
DO direction=1,3
dro(i,direction)= cell%bmat(1,direction)*drointern(i,1) &
& + cell%bmat(2,direction)*drointern(i,2)&
& + cell%bmat(3,direction)*drointern(i,3)
& + cell%bmat(2,direction)*drointern(i,2)&
& + cell%bmat(3,direction)*drointern(i,3)
dro(i,direction)= dro(i,direction)/(2.*pi_const)
END DO
END DO
END SUBROUTINE grdrsis
!--------------------------------------------------------------------
! 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)
END FUNCTION df3
REAL FUNCTION df4(g1,f0,f1,f2,d) ! four point formula
REAL g1,f0,f1,f2,d
df4 = (-2*g1-3*f0+6*f1-f2)/ (6*d)
END FUNCTION df4
REAL FUNCTION df5(g2,g1,f0,f1,f2,d) ! five point formula
REAL g2,g1,f0,f1,f2,d
df5 = (2*g2-16*g1-0*f0+16*f1-2*f2)/ (24*d)
END FUNCTION df5
REAL FUNCTION df6(g3,g2,g1,f0,f1,f2,d) ! six point formula
REAL g3,g2,g1,f0,f1,f2,d
df6 = (-4*g3+30*g2-120*g1+40*f0+60*f1-6*f2)/ (120*d)
END FUNCTION df6
!----------------------------------------------------------------------
END MODULE m_grdrsis
END DO
END DO
END SUBROUTINE grdrsis
!--------------------------------------------------------------------
! 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)
END FUNCTION df3
REAL FUNCTION df4(g1,f0,f1,f2,d) ! four point formula
REAL g1,f0,f1,f2,d
df4 = (-2*g1-3*f0+6*f1-f2)/ (6*d)
END FUNCTION df4
REAL FUNCTION df5(g2,g1,f0,f1,f2,d) ! five point formula
REAL g2,g1,f0,f1,f2,d
df5 = (2*g2-16*g1-0*f0+16*f1-2*f2)/ (24*d)
END FUNCTION df5
REAL FUNCTION df6(g3,g2,g1,f0,f1,f2,d) ! six point formula
REAL g3,g2,g1,f0,f1,f2,d
df6 = (-4*g3+30*g2-120*g1+40*f0+60*f1-6*f2)/ (120*d)
END FUNCTION df6
!----------------------------------------------------------------------
END MODULE m_grdrsis
......@@ -3,75 +3,85 @@
! 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)
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)
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
sml = 1.e-14
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)
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)
ENDDO
ENDIF
RETURN
ENDIF
DO i = 1,ndm
grad%agrt(i) = 0.0
grad%agru(i) = 0.0
grad%agrd(i) = 0.0
grad%gggrt(i) = 0.0