Commit b21e2508 authored by Alexander Neukirchen's avatar Alexander Neukirchen

Revert "removed reference to xcpot in to/from grid modules"

This reverts commit 6c3e1d60
parent 108e06a4
......@@ -101,7 +101,7 @@ CONTAINS
qtot, qistot
call tmp_potden%init(stars, atoms, sphhar, vacuum, noco, input%jspins, POTDEN_TYPE_DEN)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot%needs_grad(), sym)
call init_mt_grid(input%jspins, atoms, sphhar, xcpot, sym)
do n_atm =1,atoms%ntype
call mt_from_grid(atoms, sphhar, n_atm, input%jspins, mt(:,:,n_atm), &
tmp_potden%mt(:,0:,n_atm,:))
......@@ -112,8 +112,8 @@ CONTAINS
enddo
call finish_mt_grid()
call init_pw_grid(xcpot%needs_grad(), stars, sym, cell)
call pw_from_grid(xcpot%needs_grad(), stars, .False., is, tmp_potden%pw)
call init_pw_grid(xcpot, stars, sym, cell)
call pw_from_grid(xcpot, stars, .False., is, tmp_potden%pw)
call finish_pw_grid()
call integrate_cdn(stars,atoms,sym,vacuum,input,cell,oneD, tmp_potden, &
......
......@@ -7,7 +7,7 @@ MODULE m_lhglptg
CONTAINS
SUBROUTINE lhglptg(&
& sphhar,atoms,&
& rx,nsp,dograds,sym,&
& rx,nsp,xcpot,sym,&
& ylh,thet,phi,ylht1,ylht2,ylhf1,ylhf2,ylhtf)
!
USE m_polangle
......@@ -16,7 +16,7 @@ CONTAINS
USE m_types
IMPLICIT NONE
LOGICAL, INTENT(IN) :: dograds
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
......@@ -59,7 +59,7 @@ CONTAINS
& rx(1,k),rx(2,k),rx(3,k),&
& thet(k),phi(k))
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
CALL dylm3(&
& atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,&
& dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
......@@ -81,7 +81,7 @@ CONTAINS
ylh(k,lh,nd) = s
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
DO mem = 1,sphhar%nmem(lh,nd)
lm = ll1 + sphhar%mlh(mem,lh,nd)
......
......@@ -13,7 +13,7 @@ MODULE m_mt_tofrom_grid
REAL, ALLOCATABLE :: wt(:), rx(:, :), thet(:), phi(:)
PUBLIC :: init_mt_grid, mt_to_grid, mt_from_grid, finish_mt_grid
CONTAINS
SUBROUTINE init_mt_grid(jspins, atoms, sphhar, dograds, sym)
SUBROUTINE init_mt_grid(jspins, atoms, sphhar, xcpot, sym)
USE m_gaussp
USE m_lhglptg
USE m_lhglpts
......@@ -21,7 +21,7 @@ CONTAINS
INTEGER, INTENT(IN) :: jspins
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
LOGICAL, INTENT(IN) :: dograds
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_sym), INTENT(IN) :: sym
! generate nspd points on a sherical shell with radius 1.0
......@@ -31,14 +31,14 @@ CONTAINS
CALL gaussp(atoms%lmaxd, rx, wt)
! generate the lattice harmonics on the angular mesh
ALLOCATE (ylh(atoms%nsp(), 0:sphhar%nlhd, sphhar%ntypsd))
IF (dograds) THEN
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, atoms%nsp(), dograds, sym, &
CALL lhglptg(sphhar, atoms, rx, atoms%nsp(), xcpot, sym, &
ylh, thet, phi, ylht, ylhtt, ylhf, ylhff, ylhtf)
ELSE
CALL lhglpts(sphhar, atoms, rx, atoms%nsp(), sym, ylh)
......@@ -46,11 +46,11 @@ CONTAINS
!ENDIF
END SUBROUTINE init_mt_grid
SUBROUTINE mt_to_grid(dograds, jspins, atoms, sphhar, den_mt, n, grad, ch)
SUBROUTINE mt_to_grid(xcpot, jspins, atoms, sphhar, den_mt, n, grad, ch)
USE m_grdchlh
USE m_mkgylm
IMPLICIT NONE
LOGICAL, INTENT(IN) :: dograds
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_sphhar), INTENT(IN) :: sphhar
REAL, INTENT(IN) :: den_mt(:, 0:, :)
......@@ -69,7 +69,7 @@ CONTAINS
ALLOCATE (chlh(atoms%jmtd, 0:sphhar%nlhd, jspins))
ALLOCATE (ch_tmp(nsp, jspins))
IF (dograds) 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 (dograds) 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
......@@ -106,7 +106,7 @@ CONTAINS
ENDDO
ENDDO
ENDDO
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
chdr(:, :) = 0.0 ! d(ch)/dr
chdt(:, :) = 0.0 ! d(ch)/dtheta
chdf(:, :) = 0.0 ! d(ch)/dfai
......
......@@ -15,11 +15,11 @@ MODULE m_pw_tofrom_grid
PUBLIC :: init_pw_grid,pw_to_grid,pw_from_grid,finish_pw_grid
CONTAINS
SUBROUTINE init_pw_grid(dograds,stars,sym,cell)
SUBROUTINE init_pw_grid(xcpot,stars,sym,cell)
USE m_prpxcfftmap
USE m_types
IMPLICIT NONE
LOGICAL,INTENT(IN) :: dograds
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell
......@@ -34,13 +34,13 @@ CONTAINS
ifftd=27*stars%mx1*stars%mx2*stars%mx3
ifftxc3 = stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
CALL prp_xcfft_map(stars,sym, cell, igxc_fft,gxc_fft)
ENDIF
END SUBROUTINE init_pw_grid
SUBROUTINE pw_to_grid(dograds,jspins,l_noco,stars,cell,den_pw,grad,rho)
SUBROUTINE pw_to_grid(xcpot,jspins,l_noco,stars,cell,den_pw,grad,rho)
!.....------------------------------------------------------------------
!-------> abbreviations
!
......@@ -75,7 +75,7 @@ CONTAINS
USE m_types
use m_constants
IMPLICIT NONE
LOGICAL,INTENT(IN) :: dograds
CLASS(t_xcpot),INTENT(IN) :: xcpot
INTEGER,INTENT(IN) :: jspins
LOGICAL,INTENT(IN) :: l_noco
TYPE(t_stars),INTENT(IN) :: stars
......@@ -96,7 +96,7 @@ CONTAINS
! Allocate arrays
ALLOCATE( bf3(0:ifftd-1))
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftxc3-1,jspins))
ALLOCATE( ph_wrk(0:ifftxc3-1),rhd1(0:ifftxc3-1,jspins,3))
ALLOCATE( rhd2(0:ifftxc3-1,jspins,6) )
......@@ -104,7 +104,7 @@ CONTAINS
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftd-1,jspins))
ENDIF
IF (l_noco) THEN
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE( mx(0:ifftxc3-1),my(0:ifftxc3-1),magmom(0:ifftxc3-1))
ALLOCATE(dmagmom(0:ifftxc3-1,3),ddmagmom(0:ifftxc3-1,3,3) )
ELSE
......@@ -115,7 +115,7 @@ CONTAINS
IF (PRESENT(rho)) THEN
!Put den_pw on grid and store into rho(:,1:2)
DO js=1,jspins
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
CALL fft3dxc(rho(0:,js),bf3, den_pw(:,js), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE
......@@ -125,7 +125,7 @@ CONTAINS
IF (l_noco) THEN
! Get mx,my on real space grid and recalculate rho and magmom
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
CALL fft3dxc(mx,my, den_pw(:,3), stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,+1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE
......@@ -139,7 +139,7 @@ CONTAINS
END DO
ENDIF
ENDIF
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
! In collinear calculations all derivatives are calculated in g-spce,
! in non-collinear calculations the derivatives of |m| are calculated in real space.
......@@ -215,7 +215,7 @@ CONTAINS
ENDDO !jdm
ENDDO !idm
END IF
CALL alloc_gradients(ifftxc3,jspins,grad)
CALL xcpot%alloc_gradients(ifftxc3,jspins,grad)
!
! calculate the quantities such as abs(grad(rho)),.. used in
......@@ -238,12 +238,12 @@ CONTAINS
END SUBROUTINE pw_to_grid
SUBROUTINE pw_from_grid(dograds,stars,l_pw_w,v_in,v_out_pw,v_out_pw_w)
SUBROUTINE pw_from_grid(xcpot,stars,l_pw_w,v_in,v_out_pw,v_out_pw_w)
USE m_fft3d
USE m_fft3dxc
USE m_types
IMPLICIT NONE
LOGICAL,INTENT(IN) :: dograds
CLASS(t_xcpot),INTENT(in) :: xcpot
TYPE(t_stars),INTENT(IN) :: stars
REAL,INTENT(INOUT) :: v_in(0:,:)
LOGICAL,INTENT(in) :: l_pw_w
......@@ -258,19 +258,19 @@ CONTAINS
ALLOCATE ( vcon(0:ifftd-1) )
DO js = 1,SIZE(v_in,2)
bf3=0.0
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
CALL fft3dxc(v_in(0:,js),bf3, fg3, stars%kxc1_fft,stars%kxc2_fft,stars%kxc3_fft,&
stars%nxc3_fft,stars%kmxxc_fft,-1, stars%igfft(0:,1),igxc_fft,stars%pgfft,stars%nstr)
ELSE
vcon(0:)=v_in(0:,js)
CALL fft3d(v_in(0:,js),bf3, fg3, stars,-1)
ENDIF
DO k = 1,MERGE(stars%nxc3_fft,stars%ng3,dograds)
DO k = 1,MERGE(stars%nxc3_fft,stars%ng3,xcpot%needs_grad())
v_out_pw(k,js) = v_out_pw(k,js) + fg3(k)
ENDDO
IF (l_pw_w) THEN
IF (dograds) THEN
IF (xcpot%needs_grad()) THEN
!----> Perform fft transform: v_xc(star) --> vxc(r)
! !Use large fft mesh for convolution
fg3(stars%nxc3_fft+1:)=0.0
......
......@@ -32,9 +32,9 @@ CONTAINS
den%phi_mt(nsp*atoms%jmtd,atoms%ntype))
CALL xcpot%init("vwn",.FALSE.,1)
CALL init_mt_grid(4,atoms,sphhar,xcpot%needs_grad(),sym)
CALL init_mt_grid(4,atoms,sphhar,xcpot,sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot%needs_grad(),4,atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
CALL mt_to_grid(xcpot,4,atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
DO imesh = 1,nsp*atoms%jri(n)
rho_11 = ch(imesh,1)
......@@ -97,6 +97,7 @@ CONTAINS
TYPE(t_potden),INTENT(INOUT) :: vtot
TYPE(t_potden),dimension(3),INTENT(INOUT) :: xcB
TYPE(t_xcpot_inbuild) :: xcpot !local xcpot that is LDA to indicate we do not need gradients
TYPE(t_gradients) :: grad
......@@ -111,9 +112,9 @@ CONTAINS
ALLOCATE(livemt(size(xcB(1)%mt,1),size(xcB(1)%mt,2),size(xcB(1)%mt,3),3))
CALL xcpot%init("vwn",.FALSE.,1)
CALL init_mt_grid(4,atoms,sphhar,xcpot%needs_grad(),sym)
CALL init_mt_grid(4,atoms,sphhar,xcpot,sym)
DO n=1,atoms%ntype
CALL mt_to_grid(xcpot%needs_grad(),4,atoms,sphhar,vtot%mt(:,0:,n,:),n,grad,ch)
CALL mt_to_grid(xcpot,4,atoms,sphhar,vtot%mt(:,0:,n,:),n,grad,ch)
DO imesh = 1,nsp*atoms%jri(n)
vup = ch(imesh,1)
vdown = ch(imesh,2)
......
......@@ -55,10 +55,10 @@ CONTAINS
perform_MetaGGA = ALLOCATED(EnergyDen%mt) &
.AND. (xcpot%exc_is_MetaGGA() .or. xcpot%vx_is_MetaGGA())
CALL init_pw_grid(xcpot%needs_grad(),stars,sym,cell)
CALL init_pw_grid(xcpot,stars,sym,cell)
!Put the charge on the grid, in GGA case also calculate gradients
CALL pw_to_grid(xcpot%needs_grad(),input%jspins,noco%l_noco,stars,cell,den%pw,grad,rho)
CALL pw_to_grid(xcpot,input%jspins,noco%l_noco,stars,cell,den%pw,grad,rho)
ALLOCATE(v_xc,mold=rho)
ALLOCATE(v_x,mold=rho)
......@@ -76,8 +76,8 @@ CONTAINS
END SELECT
ENDIF
!Put the potentials in rez. space.
CALL pw_from_grid(xcpot%needs_grad(),stars,input%total,v_xc,vTot%pw,vTot%pw_w)
CALL pw_from_grid(xcpot%needs_grad(),stars,input%total,v_x,vx%pw,vx%pw_w)
CALL pw_from_grid(xcpot,stars,input%total,v_xc,vTot%pw,vTot%pw_w)
CALL pw_from_grid(xcpot,stars,input%total,v_x,vx%pw,vx%pw_w)
!calculate the ex.-cor energy density
IF (ALLOCATED(exc%pw_w)) THEN
......@@ -88,7 +88,7 @@ CONTAINS
ELSE
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad, mt_call=.False.)
ENDIF
CALL pw_from_grid(xcpot%needs_grad(),stars,.TRUE.,e_xc,exc%pw,exc%pw_w)
CALL pw_from_grid(xcpot,stars,.TRUE.,e_xc,exc%pw,exc%pw_w)
ENDIF
CALL finish_pw_grid()
......
......@@ -87,7 +87,7 @@
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%needs_grad()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
CALL init_mt_grid(input%jspins,atoms,sphhar,xcpot%needs_grad(),sym)
CALL init_mt_grid(input%jspins,atoms,sphhar,xcpot,sym)
#ifdef CPP_MPI
n_start=mpi%irank+1
......@@ -105,7 +105,7 @@
call xcpot%kinED%alloc_mt(nsp*atoms%jmtd,input%jspins, n_start, atoms%ntype, n_stride)
DO n = n_start,atoms%ntype,n_stride
loc_n = loc_n + 1
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),n,grad,ch)
!
! calculate the ex.-cor. potential
......
......@@ -35,7 +35,7 @@ CONTAINS
vsigma_mt(i,:,:)=vsigma_mt(i,:,:)*atoms%rmsh(i,n)**2
ENDDO
ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
CALL mt_to_grid(xcpot%needs_grad(),n_sigma,atoms,sphhar,vsigma_mt,n,grad=grad_vsigma)
CALL mt_to_grid(xcpot,n_sigma,atoms,sphhar,vsigma_mt,n,grad=grad_vsigma)
CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
END SUBROUTINE libxc_postprocess_gga_mt
......@@ -60,10 +60,10 @@ CONTAINS
n_sigma=MERGE(1,3,SIZE(v_xc,2)==1) !See in _mt routine
ALLOCATE(vsigma_g(stars%ng3,n_sigma),vsigma(nsp,n_sigma)); vsigma_g=0.0
vsigma=TRANSPOSE(grad%vsigma) !create a (nsp,n_sigma) matrix
CALL pw_from_grid(xcpot%needs_grad(),stars,.FALSE.,vsigma,vsigma_g)
CALL pw_from_grid(xcpot,stars,.FALSE.,vsigma,vsigma_g)
!vsigma_g(:,1)=vsigma_g(:,1)*stars%nstr(:)
ALLOCATE(grad_vsigma%gr(3,nsp,n_sigma))
CALL pw_to_grid(xcpot%needs_grad(),n_sigma,.false.,stars,cell,vsigma_g,grad_vsigma)
CALL pw_to_grid(xcpot,n_sigma,.false.,stars,cell,vsigma_g,grad_vsigma)
CALL libxc_postprocess_gga(transpose(grad%vsigma),grad,grad_vsigma,v_xc)
END SUBROUTINE libxc_postprocess_gga_pw
......
......@@ -251,13 +251,13 @@ CONTAINS
REAL, ALLOCATABLE :: den_rs(:,:), ED_rs(:,:), vTot_rs(:,:)
TYPE(t_gradients) :: tmp_grad
CALL init_pw_grid(xcpot%needs_grad(),stars,sym,cell)
CALL init_pw_grid(xcpot,stars,sym,cell)
CALL pw_to_grid(xcpot%needs_grad(), input%jspins, noco%l_noco, stars, &
CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
cell, EnergyDen%pw, tmp_grad, ED_rs)
CALL pw_to_grid(xcpot%needs_grad(), input%jspins, noco%l_noco, stars, &
CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
cell, vTot%pw, tmp_grad, vTot_rs)
CALL pw_to_grid(xcpot%needs_grad(), input%jspins, noco%l_noco, stars, &
CALL pw_to_grid(xcpot, input%jspins, noco%l_noco, stars, &
cell, den%pw, tmp_grad, den_rs)
CALL finish_pw_grid()
......@@ -293,7 +293,7 @@ CONTAINS
n_start=1
n_stride=1
#endif
CALL init_mt_grid(input%jspins,atoms,sphhar,xcpot%needs_grad(),sym)
CALL init_mt_grid(input%jspins,atoms,sphhar,xcpot,sym)
loc_n = 0
allocate(ED_rs(atoms%nsp()*atoms%jmtd, input%jspins))
allocate(vTot_rs, mold=ED_rs)
......@@ -316,19 +316,19 @@ CONTAINS
do jr=1,atoms%jri(n)
vTot_mt(jr,0:,:) = vTot%mt(jr,0:,n,:) * atoms%rmsh(jr,n)**2
enddo
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms, sphhar, EnergyDen%mt(:, 0:, n, :), &
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, EnergyDen%mt(:, 0:, n, :), &
n, tmp_grad, ED_rs)
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms, sphhar, vTot_mt(:,0:,:), &
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, vTot_mt(:,0:,:), &
n, tmp_grad, vTot_rs)
tmp_sphhar%nlhd = sphhar%nlhd
tmp_sphhar%nlh = [(0, cnt=1,size(sphhar%nlh))]
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms, tmp_sphhar, vTot_mt(:,0:0,:), &
CALL mt_to_grid(xcpot, input%jspins, atoms, tmp_sphhar, vTot_mt(:,0:0,:), &
n, tmp_grad, vTot0_rs)
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms, sphhar, &
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, &
core_den%mt(:,0:,n,:), n, tmp_grad, core_den_rs)
CALL mt_to_grid(xcpot%needs_grad(), input%jspins, atoms, sphhar, &
CALL mt_to_grid(xcpot, input%jspins, atoms, sphhar, &
val_den%mt(:,0:,n,:), n, tmp_grad, val_den_rs)
call calc_kinEnergyDen_mt(ED_RS, vTot_rs, vTot0_rs, core_den_rs, val_den_rs, &
......
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