Commit 522a929c authored by Matthias Redies's avatar Matthias Redies

switched from is_gga to needs_grad

parent 4d6e2292
......@@ -174,7 +174,7 @@ SUBROUTINE initParallelProcesses(atoms,vacuum,input,stars,sliceplot,banddos,&
ALLOCATE(hybrid%select1(4,atoms%ntype),hybrid%lcutm1(atoms%ntype))
ALLOCATE(hybrid%lcutwf(atoms%ntype))
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
......@@ -38,7 +38,7 @@
oneD%igfft1(0:oneD%odd%nn2d-1,1:2) = 0
oneD%pgfft1(0:oneD%odd%nn2d-1) = 0.
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
! ALLOCATE ( odg%pgfx(0:odg%nn2d-1),
! & odg%pgfy(0:odg%nn2d-1),
! & odg%pgfxx(0:odg%nn2d-1),
......@@ -125,7 +125,7 @@
oneD%pgfft1(i-1) = 1.
ENDDO
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
DO i = 1,oneD%odd%nq2
kfx_1 = oneD%kv1(1,i)
kfy_1 = oneD%kv1(2,i)
......
......@@ -164,7 +164,7 @@ CONTAINS
cell,sliceplot,noco,&
stars,oneD,hybrid,kpts,a1,a2,a3,namex,relcor)
!
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
......@@ -261,7 +261,7 @@
!!$ !+guta
!!$ IF ((xcpot%icorr.EQ.-1).OR.(xcpot%icorr.GE.6)) THEN
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
obsolete%ndvgrd = MAX(obsolete%ndvgrd,3)
......@@ -360,7 +360,7 @@
!
! check muffin tin radii
!
l_gga= xcpot%vxc_is_gga()
l_gga= xcpot%needs_grad()
l_test = .TRUE. ! only checking, dont use new parameters
CALL chkmt(atoms,input,vacuum,cell,oneD,l_gga,noel,l_test, kmax1,dtild,dvac1,lmax1,jri1,rmt1,dx1)
......
......@@ -317,7 +317,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
ALLOCATE (jri1(atoms%ntype), lmax1(atoms%ntype))
ALLOCATE (rmt1(atoms%ntype), dx1(atoms%ntype))
l_test = .TRUE. ! only checking, dont use new parameters
l_gga=xcpot%vxc_is_gga()
l_gga=xcpot%needs_grad()
CALL chkmt(atoms,input,vacuum,cell,oneD,l_gga,noel,l_test,&
kmax1,dtild1,dvac1,lmax1,jri1,rmt1,dx1)
DEALLOCATE (jri1,lmax1,rmt1,dx1)
......@@ -479,7 +479,7 @@ SUBROUTINE postprocessInput(mpi,input,field,sym,stars,atoms,vacuum,obsolete,kpts
ENDIF
! Missing xc functionals initializations
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE (stars%ft2_gfx(0:stars%kimax2),stars%ft2_gfy(0:stars%kimax2))
ALLOCATE (oneD%pgft1x(0:oneD%odd%nn2d-1),oneD%pgft1xx(0:oneD%odd%nn2d-1),&
oneD%pgft1xy(0:oneD%odd%nn2d-1),&
......
......@@ -82,7 +82,7 @@
! arltv(i) : length of reciprical lattice vector along
! direction (i)
!
IF (.NOT.xcpot%vxc_is_gga()) xcpot%gmaxxc=stars%gmax
IF (.NOT.xcpot%needs_grad()) 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'',&
......
......@@ -63,7 +63,7 @@ CONTAINS
!
!WRITE (*,*) ' stars are always ordered '
l_xcExtended = xcpot%vxc_is_gga()
l_xcExtended = xcpot%needs_grad()
!---> read in information if exists
CALL readStars(stars,l_xcExtended,.TRUE.,l_error)
IF(.NOT.l_error) THEN
......@@ -383,7 +383,7 @@ CONTAINS
stars%igfft2(kidx2,2) = kfft
stars%pgfft2(kidx2) = phas(n)
!+guta
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
!! pgft2x: exp(i*(gfx,gfy,gfz)*tau)*gfx.
!! y y.
!! pgft2xx: exp(i*(gfx,gfy,gfz)*tau)*gfx*gfx.
......@@ -610,7 +610,7 @@ CONTAINS
!
WRITE (*,*) ' stars are always ordered '
l_xcExtended = xcpot%vxc_is_gga()
l_xcExtended = xcpot%needs_grad()
!---> read in information if exists
CALL readStars(stars,l_xcExtended,.FALSE.,l_error)
IF(.NOT.l_error) THEN
......@@ -856,7 +856,7 @@ CONTAINS
judft_error("BUG 1 in strgen")
stars%ng2 = 2 ; stars%kv2 = 0 ; stars%ig2 = 0 ; stars%kimax2= 0 ; stars%igfft2 = 0
stars%sk2 = 0.0 ; stars%pgfft2 = 0.0 ; stars%nstr2 = 0
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
stars%ft2_gfx = 0.0 ; stars%ft2_gfy = 0.0
ENDIF
......
......@@ -1195,12 +1195,12 @@ input%preconditioning_param = evaluateFirstOnly(xmlGetAttributeValue('/fleurInpu
ALLOCATE(hybrid%lcutm1(atoms%ntype),hybrid%lcutwf(atoms%ntype),hybrid%select1(4,atoms%ntype))
obsolete%lwb=.FALSE.
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
obsolete%ndvgrd=6
obsolete%chng=-0.1e-11
END IF
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
obsolete%ndvgrd = MAX(obsolete%ndvgrd,3)
END IF
......
......@@ -218,7 +218,7 @@
rhoss(i,ispin) = rhoss(i,ispin) / (fpi_const*rad(i)**2)
ENDDO
ENDDO
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
CALL potl0(xcpot,DIMENSION%msh,DIMENSION%jspd,input%jspins,n,&
atoms%dx(ntyp), rad, rhoss, vxc)
ELSE
......
......@@ -210,7 +210,7 @@ CONTAINS
vxc(:,:) = 0.0
ngrid=SIZE(rh,1)
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
IF (xcpot%is_name("l91")) THEN ! local pw91
CALL vxcl91(jspins,ngrid,ngrid,rh,grad%agrt(:ngrid),grad%agru(:ngrid),grad%agrd(:ngrid), grad%g2rt(:ngrid),&
......
......@@ -221,7 +221,7 @@ CONTAINS
!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%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
IF (.NOT.PRESENT(grad)) CALL judft_error("Bug: You called get_vxc for a GGA potential without providing derivatives")
ALLOCATE(vsigma,mold=grad%vsigma)
!where(abs(grad%sigma)<1E-9) grad%sigma=1E-9
......@@ -265,12 +265,17 @@ CONTAINS
CALL xc_f03_gga_exc(xcpot%exc_func_c, SIZE(rh,1), TRANSPOSE(rh),grad%sigma,excc)
exc=exc+excc
END IF
ELSE !LDA potentials
ELSEIF(xcpot%exc_is_LDA()) THEN !LDA potentials
CALL xc_f03_lda_exc(xcpot%exc_func_x, SIZE(rh,1), TRANSPOSE(rh), exc)
IF (xcpot%func_exc_id_c>0) THEN
CALL xc_f03_lda_exc(xcpot%exc_func_c, SIZE(rh,1), TRANSPOSE(rh), excc)
exc=exc+excc
END IF
ELSEIF(xcpot%exc_is_MetaGGA()) THEN
!call xc_f03_mgga_exc(xcpot%exc_func_x, SIZE(rh,1), TRANSPOSE(rh), grad%sigma, transpose(grad%laplace)
write (*,*) "have to implement that"
ELSE
call juDFT_error("exc is part of a known Family", calledby="xcpot_get_exc@libxc")
ENDIF
#endif
......
......@@ -58,7 +58,7 @@ CONTAINS
& rx(1,k),rx(2,k),rx(3,k),&
& thet(k),phi)
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
CALL dylm3(&
& atoms%lmaxd,atoms%lmaxd,rx(:,k),ylm,&
& dylmt1,dylmt2,dylmf1,dylmf2,dylmtf)
......@@ -80,7 +80,7 @@ CONTAINS
ylh(k,lh,nd) = s
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
DO mem = 1,sphhar%nmem(lh,nd)
lm = ll1 + sphhar%mlh(mem,lh,nd)
......
......@@ -35,7 +35,7 @@ CONTAINS
ifftd=27*stars%mx1*stars%mx2*stars%mx3
ifftxc3d = stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
ALLOCATE ( igxc_fft(0:ifftxc3d-1),gxc_fft(0:ifftxc3d-1,3) )
CALL prp_xcfft_map(stars,sym, cell, igxc_fft,gxc_fft)
ENDIF
......@@ -99,7 +99,7 @@ CONTAINS
! Allocate arrays
ALLOCATE( bf3(0:ifftd-1))
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftxc3d-1,jspins))
ALLOCATE( ph_wrk(0:ifftxc3d-1),rhd1(0:ifftxc3d-1,jspins,3))
ALLOCATE( rhd2(0:ifftxc3d-1,jspins,6) )
......@@ -107,7 +107,7 @@ CONTAINS
IF (PRESENT(rho)) ALLOCATE(rho(0:ifftd-1,jspins))
ENDIF
IF (l_noco) THEN
IF (xcpot%vxc_is_gga()) 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
......@@ -117,7 +117,7 @@ CONTAINS
IF (PRESENT(rho)) THEN
!Put den_pw on grid and store into rho(:,1:2)
DO js=1,jspins
IF (xcpot%vxc_is_gga()) 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
......@@ -127,7 +127,7 @@ CONTAINS
IF (l_noco) THEN
! Get mx,my on real space grid and recalculate rho and magmom
IF (xcpot%vxc_is_gga()) 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
......@@ -141,7 +141,7 @@ CONTAINS
END DO
ENDIF
ENDIF
IF (xcpot%vxc_is_gga()) 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.
......@@ -258,19 +258,19 @@ CONTAINS
ALLOCATE ( vcon(0:ifftd-1) )
DO js = 1,SIZE(v_in,2)
bf3=0.0
IF (xcpot%vxc_is_gga()) 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,xcpot%vxc_is_gga())
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 (xcpot%vxc_is_gga()) 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
......
......@@ -86,7 +86,7 @@ CONTAINS
ifftd2 = 9*stars%mx1*stars%mx2
IF (oneD%odi%d1) ifftd2 = 9*stars%mx3*oneD%odi%M
IF (.NOT.xcpot%vxc_is_gga()) THEN ! LDA
IF (.NOT.xcpot%needs_grad()) THEN ! LDA
IF (.NOT.oneD%odi%d1) THEN
CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,Den,vTot,exc)
......@@ -114,7 +114,7 @@ CONTAINS
CALL timestart("Vxc in interstitial")
IF ( (.NOT. obsolete%lwb) .OR. ( .not.xcpot%vxc_is_gga() ) ) THEN
IF ( (.NOT. obsolete%lwb) .OR. ( .not.xcpot%needs_grad() ) ) THEN
! no White-Bird-trick
CALL vis_xc(stars,sym,cell,den,xcpot,input,noco,vTot,vx,exc)
......
......@@ -57,7 +57,7 @@ CONTAINS
CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
SELECT TYPE(xcpot)
TYPE IS (t_xcpot_libxc)
CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
......
......@@ -80,7 +80,7 @@ CONTAINS
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%vxc_is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
IF (xcpot%needs_grad()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym)
......@@ -117,7 +117,7 @@ CONTAINS
ENDIF
!Add postprocessing for libxc
IF (l_libxc.AND.xcpot%vxc_is_gga()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad)
IF (l_libxc.AND.xcpot%needs_grad()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad)
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_xc,vxc%mt(:,0:,n,:))
......
......@@ -141,7 +141,7 @@ CONTAINS
! ENDDO ! ivac
! DO ivac = 1,nvac
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
DO js=1,input%jspins
!
! calculate first (rhtdz) & second (rhtdzz) derivative of den%vacz(1:nmz)
......@@ -237,7 +237,7 @@ CONTAINS
END IF
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
! calculate derivatives with respect to x,y in g-space
! and transform them to real-space.
......@@ -491,7 +491,7 @@ CONTAINS
!c energy.
CALL xcpot%alloc_gradients(nmzdiff,input%jspins,grad)
IF (xcpot%vxc_is_gga()) THEN
IF (xcpot%needs_grad()) THEN
if(oneD%odi%d1)then
! CALL od_mkgz(&
! cell%z1,vacuum%nmzxy,vacuum%delz,&
......
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