Commit 869a13a2 authored by Gregor Michalicek's avatar Gregor Michalicek

Bugfix for hybrid functionals in vgen/vgen_xcpot.F90

   ...vXC%pw_w was not initialized.

   + some code beautification
parent e10a5740
......@@ -19,9 +19,8 @@ CONTAINS
!! TE_VEFF: charge density-effective potential integral
!! 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, vx, vCoul )
SUBROUTINE vgen(hybrid,field,input,xcpot,DIMENSION,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,results,noco,den,vTot,vXC,vCoul)
USE m_rotate_int_den_to_local
USE m_bfield
......@@ -52,7 +51,7 @@ 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,vx,vCoul
TYPE(t_potden), INTENT(INOUT) :: vTot,vXC,vCoul
TYPE(t_potden) :: workden,denRot
......@@ -61,42 +60,38 @@ CONTAINS
CALL vTot%resetPotDen()
CALL vCoul%resetPotDen()
CALL vx%resetPotDen()
ALLOCATE( vx%pw_w, vTot%pw_w, mold=vTot%pw )
ALLOCATE( vCoul%pw_w(SIZE(den%pw,1),1) )
CALL vXC%resetPotDen()
ALLOCATE(vXC%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 )
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 den%sum_both_spin(workden)
CALL vgen_coulomb( 1, mpi, DIMENSION, oneD, input, field, vacuum, sym, stars, cell, &
sphhar, atoms, workden, vCoul, results )
CALL vgen_coulomb(1,mpi,dimension,oneD,input,field,vacuum,sym,stars,cell,sphhar,atoms,workden,vCoul,results)
CALL vCoul%copy_both_spin( vTot )
CALL vCoul%copy_both_spin(vTot)
IF (noco%l_noco) THEN
CALL denRot%init( stars, atoms, sphhar, vacuum, input%jspins, noco%l_noco, 0 )
CALL denRot%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,0)
denRot=den
CALL rotate_int_den_to_local( DIMENSION, sym, stars, atoms, sphhar, vacuum, cell, input, &
noco, oneD, denRot )
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, vx, results )
CALL vgen_xcpot(hybrid,input,xcpot,dimension,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,vTot,vXC,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, vx%pw_w )
CALL vgen_finalize(atoms,stars,vacuum,sym,noco,input,vTot,denRot)
DEALLOCATE(vcoul%pw_w,vXC%pw_w)
CALL bfield(input,noco,atoms,field,vTot)
CALL bfield( input, noco, atoms, field, vTot )
! broadcast potentials
#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, vx )
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)
#endif
END SUBROUTINE vgen
......
......@@ -4,10 +4,14 @@
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_vgen_xcpot
USE m_juDFT
CONTAINS
SUBROUTINE vgen_xcpot(hybrid,input,xcpot,DIMENSION, atoms,sphhar,stars,&
vacuum,sym, obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,vTot,vx,results)
SUBROUTINE vgen_xcpot(hybrid,input,xcpot,dimension,atoms,sphhar,stars,vacuum,sym,&
obsolete,cell,oneD,sliceplot,mpi,noco,den,denRot,vTot,vXC,results)
! ***********************************************************
! FLAPW potential generator *
! ***********************************************************
......@@ -17,6 +21,8 @@ CONTAINS
! TE_VEFF: charge density-effective potential integral
! TE_EXC : charge density-ex-corr.energy density integral
! ***********************************************************
USE m_types
USE m_constants
USE m_intnv
USE m_vmtxcg
......@@ -26,37 +32,34 @@ CONTAINS
USE m_visxc
USE m_visxcg
USE m_checkdopall
USE m_cdn_io
USE m_types
USE m_cdn_io
USE m_convol
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_hybrid),INTENT(IN) :: hybrid
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_sliceplot),INTENT(IN) :: sliceplot
TYPE(t_input),INTENT(IN) :: input
TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden), INTENT(IN) :: den, denRot
TYPE(t_potden),INTENT(INOUT) :: vTot,vx
TYPE(t_results),INTENT(INOUT),OPTIONAL :: results
! ..
! .. Local type instances ..
TYPE(t_potden) :: workDen,exc,veff
! .. Local Scalars ..
INTEGER i,i3,irec2,irec3,ivac,j,js,k,k3,lh,n,nzst1
INTEGER ifftd,ifftd2, ifftxc3d
INTEGER jsp,l
CLASS(t_xcpot), INTENT(IN) :: xcpot
TYPE(t_hybrid), INTENT(IN) :: hybrid
TYPE(t_mpi), INTENT(IN) :: mpi
TYPE(t_dimension), INTENT(IN) :: dimension
TYPE(t_oneD), INTENT(IN) :: oneD
TYPE(t_obsolete), INTENT(IN) :: obsolete
TYPE(t_sliceplot), INTENT(IN) :: sliceplot
TYPE(t_input), INTENT(IN) :: input
TYPE(t_vacuum), INTENT(IN) :: vacuum
TYPE(t_noco), INTENT(IN) :: noco
TYPE(t_sym), INTENT(IN) :: sym
TYPE(t_stars), INTENT(IN) :: stars
TYPE(t_cell), INTENT(IN) :: cell
TYPE(t_sphhar), INTENT(IN) :: sphhar
TYPE(t_atoms), INTENT(IN) :: atoms
TYPE(t_potden), INTENT(IN) :: den,denRot
TYPE(t_potden), INTENT(INOUT) :: vTot,vXC
TYPE(t_results), INTENT(INOUT), OPTIONAL :: results
! Local type instances
TYPE(t_potden) :: workDen,exc,veff
! Local Scalars
INTEGER ifftd,ifftd2,ifftxc3d,ispin
#ifdef CPP_MPI
include 'mpif.h'
integer:: ierr
......@@ -69,13 +72,11 @@ CONTAINS
ALLOCATE(veff%pw_w,mold=veff%pw)
ENDIF
! ******** exchange correlation potential******************
! exchange correlation potential
! ---> vacuum region
! vacuum region
IF (mpi%irank == 0) THEN
IF (input%film) THEN
CALL timestart("Vxc in vacuum")
ifftd2 = 9*stars%mx1*stars%mx2
......@@ -84,163 +85,115 @@ CONTAINS
IF (.NOT.xcpot%is_gga()) THEN ! LDA
IF (.NOT.oneD%odi%d1) THEN
CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,Den,&
vTot,exc)
CALL vvacxc(ifftd2,stars,vacuum,xcpot,input,noco,Den,vTot,exc)
ELSE
CALL judft_error("OneD broken")
! CALL vvacxc(&
! & stars,oneD%M,vacuum,odi%n2d,dimension,ifftd2,&
! & xcpot,input,odi%nq2,&
! & odi%nst2,den,noco,&
! & odi%kimax2%igf,odl%pgf,&
! & vTot%vacxy,vTot%vacz,&
! & excxy,excz)
ENDIF
! CALL vvacxc(stars,oneD%M,vacuum,odi%n2d,dimension,ifftd2,&
! xcpot,input,odi%nq2,odi%nst2,den,noco,odi%kimax2%igf,&
! odl%pgf,vTot%vacxy,vTot%vacz,excxy,excz)
END IF
ELSE ! GGA
IF (oneD%odi%d1) THEN
CALL judft_error("OneD broken")
!CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,&
! cell,xcpot,input,obsolete,workDen, ichsmrg,&
! vTot%vacxy,vTot%vacz,rhmn, exc%vacxy,exc%vacz)
! CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,&
! cell,xcpot,input,obsolete,workDen, ichsmrg,&
! vTot%vacxy,vTot%vacz,rhmn, exc%vacxy,exc%vacz)
ELSE
CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,&
cell,xcpot,input,obsolete,Den, &
vTot, exc)
CALL vvacxcg(ifftd2,stars,vacuum,noco,oneD,cell,xcpot,input,obsolete,Den,vTot,exc)
END IF
END IF
CALL timestop("Vxc in vacuum")
!+odim
END IF
! ----------------------------------------
! ---> interstitial region
! interstitial region
CALL timestart("Vxc in interstitial")
ifftd=27*stars%mx1*stars%mx2*stars%mx3
ifftd = 27*stars%mx1*stars%mx2*stars%mx3
IF ( (.NOT. obsolete%lwb) .OR. ( .not.xcpot%is_gga() ) ) THEN
IF ((.NOT.obsolete%lwb).OR.(.NOT.xcpot%is_gga())) THEN
! no White-Bird-trick
ifftxc3d = stars%kxc1_fft*stars%kxc2_fft*stars%kxc3_fft
IF ( .NOT.xcpot%is_gga() ) THEN
! LDA
CALL visxc(ifftd,stars,noco,xcpot,input,den,vTot,vx,exc)
IF (.NOT.xcpot%is_gga()) THEN ! LDA
CALL visxc(ifftd,stars,noco,xcpot,input,den,vTot,vXC,exc)
ELSE ! GGA
CALL visxcg(ifftd,stars,sym,ifftxc3d,cell,den,xcpot,input,&
obsolete,noco,vTot,vx,exc)
CALL visxcg(ifftd,stars,sym,ifftxc3d,cell,den,xcpot,input,obsolete,noco,vTot,vXC,exc)
END IF
ELSE
! White-Bird-trick
WRITE(6,'(a)') "W+B trick cancelled out. visxcwb uses at present common block cpgft3.",&
"visxcwb needs to be reprogrammed according to visxcg.f"
"visxcwb needs to be reprogrammed according to visxcg.f"
CALL juDFT_error("visxcwb",calledby ="vgen")
END IF
!
CALL timestop("Vxc in interstitial")
END IF !irank==0
ENDIF !irank==0
!
! ------------------------------------------
! ----> muffin tin spheres region
IF (mpi%irank == 0) THEN
CALL timestart ("Vxc in MT")
END IF
! muffin tin spheres region
IF (mpi%irank == 0) CALL timestart ("Vxc in MT")
#ifdef CPP_MPI
CALL MPI_BCAST(den%mt,atoms%jmtd*(1+sphhar%nlhd)*atoms%ntype*dimension%jspd,MPI_DOUBLE_PRECISION,0,mpi%mpi_comm,ierr)
#endif
IF (xcpot%is_gga()) THEN
CALL vmtxcg(dimension,mpi,sphhar,atoms, den,xcpot,input,sym,&
obsolete, vTot,vx,exc)
CALL vmtxcg(dimension,mpi,sphhar,atoms,den,xcpot,input,sym,obsolete,vTot,vXC,exc)
ELSE
CALL vmtxc(DIMENSION,sphhar,atoms, den,xcpot,input,sym, vTot,exc,vx)
CALL vmtxc(DIMENSION,sphhar,atoms,den,xcpot,input,sym,vTot,exc,vXC)
ENDIF
!
! add MT EXX potential to vr
!
IF (mpi%irank == 0) THEN
CALL timestop ("Vxc in MT")
! ------------------------------------------
! ---> check continuity of total potential
IF (input%vchk) THEN
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,&
cell,vTot,1)
END IF
! check continuity of total potential
IF (input%vchk) CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,cell,vTot,1)
!
!============TOTAL======================================
!
! TOTAL
IF (PRESENT(results)) THEN
!
! CALCULATE THE INTEGRAL OF n1*Veff1 + n2*Veff2
! Veff = Vcoulomb + Vxc
!
! CALCULATE THE INTEGRAL OF n1*Veff1 + n2*Veff2
! Veff = Vcoulomb + Vxc
IF (noco%l_noco) THEN
workDen = denRot
ELSE
workden=den
ENDIF
veff=vTot
IF( xcpot%is_hybrid() ) THEN
veff%pw = vTot%pw -xcpot%get_exchange_weight() * vx%pw
veff%pw_w = vTot%pw_w - xcpot%get_exchange_weight() * vx%pw_w
veff%mt = vTot%mt - xcpot%get_exchange_weight() * vx%mt
workden = den
END IF
veff = vTot
IF(xcpot%is_hybrid()) THEN
DO ispin = 1, input%jspins
CALL convol(stars,vXC%pw_w(:,ispin),vXC%pw(:,ispin),stars%ufft)
END DO
veff%pw = vTot%pw - xcpot%get_exchange_weight() * vXC%pw
veff%pw_w = vTot%pw_w - xcpot%get_exchange_weight() * vXC%pw_w
veff%mt = vTot%mt - xcpot%get_exchange_weight() * vXC%mt
END IF
results%te_veff = 0.0
DO js = 1,input%jspins
WRITE (6,FMT=8050) js
DO ispin = 1, input%jspins
WRITE (6,FMT=8050) ispin
8050 FORMAT (/,10x,'density-effective potential integrals for spin ',i2,/)
CALL int_nv(js,stars,vacuum,atoms,sphhar, cell,sym,input,oneD,veff,workden,results%te_veff)
ENDDO
CALL int_nv(ispin,stars,vacuum,atoms,sphhar,cell,sym,input,oneD,veff,workden,results%te_veff)
END DO
WRITE (6,FMT=8060) results%te_veff
8060 FORMAT (/,10x,'total density-effective potential integral :', t40,f20.10)
!
! CALCULATE THE INTEGRAL OF n*exc
!
! ---> perform spin summation of charge densities
! ---> for the calculation of Exc
! CALCULATE THE INTEGRAL OF n*exc
! perform spin summation of charge densities for the calculation of Exc
CALL workden%sum_both_spin()
WRITE (6,FMT=8070)
8070 FORMAT (/,10x,'charge density-energy density integrals',/)
results%te_exc = 0.0
CALL int_nv(1,stars,vacuum,atoms,sphhar, cell,sym,input,oneD,&
exc,workDen, results%te_exc)
CALL int_nv(1,stars,vacuum,atoms,sphhar,cell,sym,input,oneD,exc,workDen,results%te_exc)
WRITE (6,FMT=8080) results%te_exc
8080 FORMAT (/,10x,'total charge density-energy density integral :', t40,f20.10)
END IF
ENDIF ! mpi%irank == 0
END IF ! mpi%irank == 0
END SUBROUTINE vgen_xcpot
END MODULE m_vgen_xcpot
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