Skip to content

GitLab

fleur
fleur
Commit 643a3f97 authored by Matthias Redies's avatar Matthias Redies
Browse files
Options

fix indentanion, so merges work

parent 2347d607
Hide whitespace changes
Inline Side-by-side
Showing with 189 additions and 191 deletions
vgen/vis_xc.F90
View file @ 643a3f97
......@@ -9,72 +9,72 @@
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_vis_xc
USE m_juDFT
! ******************************************************
! subroutine generates the exchange-correlation potential
! in the interstitial region c.l.fu
! including gradient corrections. t.a. 1996.
! ******************************************************
USE m_juDFT
! ******************************************************
! subroutine generates the exchange-correlation potential
! in the interstitial region c.l.fu
! including gradient corrections. t.a. 1996.
! ******************************************************
CONTAINS
SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco, vxc,vx,exc)
SUBROUTINE vis_xc(stars,sym,cell,den,xcpot,input,noco, vxc,vx,exc)
! ******************************************************
! instead of visxcor.f: the different exchange-correlation
! potentials defined through the key icorr are called through
! the driver subroutine vxcallg.f,for the energy density - excallg
! subroutines vectorized
! ** r.pentcheva 22.01.96
! *********************************************************
! in case of total = .true. calculates the ex-corr. energy
! density
! ** r.pentcheva 08.05.96
! ******************************************************************
USE m_pw_tofrom_grid
USE m_types
USE m_types_xcpot_libxc
USE m_libxc_postprocess_gga
IMPLICIT NONE
! ******************************************************
! instead of visxcor.f: the different exchange-correlation
! potentials defined through the key icorr are called through
! the driver subroutine vxcallg.f,for the energy density - excallg
! subroutines vectorized
! ** r.pentcheva 22.01.96
! *********************************************************
! in case of total = .true. calculates the ex-corr. energy
! density
! ** r.pentcheva 08.05.96
! ******************************************************************
USE m_pw_tofrom_grid
USE m_types
USE m_types_xcpot_libxc
USE m_libxc_postprocess_gga
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_input),INTENT(IN) :: input
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_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT) :: vxc,vx,exc
TYPE(t_gradients) :: grad
REAL, ALLOCATABLE :: rho(:,:)
REAL, ALLOCATABLE :: v_x(:,:),v_xc(:,:),e_xc(:,:)
CALL init_pw_grid(xcpot,stars,sym,cell)
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_input),INTENT(IN) :: input
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_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT) :: vxc,vx,exc
!Put the charge on the grid, in GGA case also calculate gradients
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)
TYPE(t_gradients) :: grad
REAL, ALLOCATABLE :: rho(:,:)
REAL, ALLOCATABLE :: v_x(:,:),v_xc(:,:),e_xc(:,:)
CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
CALL init_pw_grid(xcpot,stars,sym,cell)
IF (xcpot%is_gga()) THEN
SELECT TYPE(xcpot)
TYPE IS (t_xcpot_libxc)
CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
END SELECT
ENDIF
!Put the potentials in rez. space.
CALL pw_from_grid(xcpot,stars,input%total,v_xc,vxc%pw,vxc%pw_w)
CALL pw_from_grid(xcpot,stars,input%total,v_x,vx%pw,vx%pw_w)
!Put the charge on the grid, in GGA case also calculate gradients
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)
!calculate the ex.-cor energy density
IF (ALLOCATED(exc%pw_w)) THEN
ALLOCATE ( e_xc(SIZE(rho,1),1) );e_xc=0.0
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad)
CALL pw_from_grid(xcpot,stars,.TRUE.,e_xc,exc%pw,exc%pw_w)
ENDIF
CALL xcpot%get_vxc(input%jspins,rho,v_xc,v_x,grad)
CALL finish_pw_grid()
END SUBROUTINE vis_xc
IF (xcpot%is_gga()) THEN
SELECT TYPE(xcpot)
TYPE IS (t_xcpot_libxc)
CALL libxc_postprocess_gga_pw(xcpot,stars,cell,v_xc,grad)
END SELECT
ENDIF
!Put the potentials in rez. space.
CALL pw_from_grid(xcpot,stars,input%total,v_xc,vxc%pw,vxc%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
ALLOCATE ( e_xc(SIZE(rho,1),1) ); e_xc=0.0
CALL xcpot%get_exc(input%jspins,rho,e_xc(:,1),grad)
CALL pw_from_grid(xcpot,stars,.TRUE.,e_xc,exc%pw,exc%pw_w)
ENDIF
CALL finish_pw_grid()
END SUBROUTINE vis_xc
END MODULE m_vis_xc
vgen/vmt_xc.F90
View file @ 643a3f97
......@@ -4,152 +4,150 @@
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_vmt_xc
!.....------------------------------------------------------------------
! Calculate the GGA xc-potential in the MT-spheres
!.....------------------------------------------------------------------
! instead of vmtxcor.f: the different exchange-correlation
! potentials defined through the key icorr are called through
! the driver subroutine vxcallg.f, subroutines vectorized
! ** r.pentcheva 22.01.96
! *********************************************************
! angular mesh calculated on speacial gauss-legendre points
! in order to use orthogonality of lattice harmonics and
! avoid a least square fit
! ** r.pentcheva 04.03.96
! *********************************************************
! MPI and OpenMP parallelization
! U.Alekseeva, February 2017
! *********************************************************
!.....------------------------------------------------------------------
! Calculate the GGA xc-potential in the MT-spheres
!.....------------------------------------------------------------------
! instead of vmtxcor.f: the different exchange-correlation
! potentials defined through the key icorr are called through
! the driver subroutine vxcallg.f, subroutines vectorized
! ** r.pentcheva 22.01.96
! *********************************************************
! angular mesh calculated on speacial gauss-legendre points
! in order to use orthogonality of lattice harmonics and
! avoid a least square fit
! ** r.pentcheva 04.03.96
! *********************************************************
! MPI and OpenMP parallelization
! U.Alekseeva, February 2017
! *********************************************************
CONTAINS
SUBROUTINE vmt_xc(DIMENSION,mpi,sphhar,atoms,&
den,xcpot,input,sym, obsolete,vxc,vx,exc)
SUBROUTINE vmt_xc(DIMENSION,mpi,sphhar,atoms,&
den,xcpot,input,sym, obsolete,vxc,vx,exc)
#include"cpp_double.h"
use m_libxc_postprocess_gga
USE m_mt_tofrom_grid
USE m_types_xcpot_inbuild
USE m_types
IMPLICIT NONE
use m_libxc_postprocess_gga
USE m_mt_tofrom_grid
USE m_types_xcpot_inbuild
USE m_types
IMPLICIT NONE
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT) :: vxc,vx,exc
CLASS(t_xcpot),INTENT(IN) :: xcpot
TYPE(t_dimension),INTENT(IN) :: dimension
TYPE(t_mpi),INTENT(IN) :: mpi
TYPE(t_obsolete),INTENT(IN) :: obsolete
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_potden),INTENT(IN) :: den
TYPE(t_potden),INTENT(INOUT) :: vxc,vx,exc
#ifdef CPP_MPI
include "mpif.h"
include "mpif.h"
#endif
! ..
! .. Local Scalars ..
TYPE(t_gradients) :: grad
TYPE(t_xcpot_inbuild) :: xcpot_tmp
REAL, ALLOCATABLE :: ch(:,:)
INTEGER :: n,nsp,nt,jr
REAL :: divi
! ..
!locals for mpi
integer :: ierr
integer:: n_start,n_stride
REAL:: v_x((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
REAL:: v_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
REAL:: e_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,1)
REAL,ALLOCATABLE:: xcl(:,:)
LOGICAL :: lda_atom(atoms%ntype),l_libxc
!.....------------------------------------------------------------------
lda_atom=.FALSE.;l_libxc=.FALSE.
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
lda_atom=xcpot%lda_atom
IF (ANY(lda_atom)) THEN
IF((.NOT.xcpot%is_name("pw91"))) &
! ..
! .. Local Scalars ..
TYPE(t_gradients) :: grad
TYPE(t_xcpot_inbuild) :: xcpot_tmp
REAL, ALLOCATABLE :: ch(:,:)
INTEGER :: n,nsp,nt,jr
REAL :: divi
! ..
!locals for mpi
integer :: ierr
integer:: n_start,n_stride
REAL:: v_x((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
REAL:: v_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,input%jspins)
REAL:: e_xc((atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)*atoms%jmtd,1)
REAL,ALLOCATABLE:: xcl(:,:)
LOGICAL :: lda_atom(atoms%ntype),l_libxc
!.....------------------------------------------------------------------
lda_atom=.FALSE.; l_libxc=.FALSE.
SELECT TYPE(xcpot)
TYPE IS(t_xcpot_inbuild)
lda_atom=xcpot%lda_atom
IF (ANY(lda_atom)) THEN
IF((.NOT.xcpot%is_name("pw91"))) &
CALL judft_warn("Using locally LDA only possible with pw91 functional")
CALL xcpot_tmp%init("l91",.FALSE.,atoms%ntype)
ALLOCATE(xcl(SIZE(v_xc,1),SIZE(v_xc,2)))
ENDIF
CLASS DEFAULT
l_libxc=.true. !libxc!!
END SELECT
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym)
CALL xcpot_tmp%init("l91",.FALSE.,atoms%ntype)
ALLOCATE(xcl(SIZE(v_xc,1),SIZE(v_xc,2)))
ENDIF
CLASS DEFAULT
l_libxc=.true. !libxc!!
END SELECT
nsp=(atoms%lmaxd+1+MOD(atoms%lmaxd+1,2))*(2*atoms%lmaxd+1)
ALLOCATE(ch(nsp*atoms%jmtd,input%jspins))
IF (xcpot%is_gga()) CALL xcpot%alloc_gradients(SIZE(ch,1),input%jspins,grad)
CALL init_mt_grid(nsp,input%jspins,atoms,sphhar,xcpot,sym)
#ifdef CPP_MPI
n_start=mpi%irank+1
n_stride=mpi%isize
IF (mpi%irank>0) THEN
vxc%mt=0.0
vx%mt=0.0
exc%mt=0.0
ENDIF
n_start=mpi%irank+1
n_stride=mpi%isize
IF (mpi%irank>0) THEN
vxc%mt=0.0
vx%mt=0.0
exc%mt=0.0
ENDIF
#else
n_start=1
n_stride=1
n_start=1
n_stride=1
#endif
DO n = n_start,atoms%ntype,n_stride
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),nsp,n,grad,ch)
!
! calculate the ex.-cor. potential
CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
IF (lda_atom(n)) THEN
! Use local part of pw91 for this atom
CALL xcpot_tmp%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
!Mix the potentials
divi = 1.0 / (atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(1,n))
nt=0
DO jr=1,atoms%jri(n)
v_xc(nt+1:nt+nsp,:) = ( xcl(nt+1:nt+nsp,:) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
v_xc(nt+1:nt+nsp,:) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
nt=nt+nsp
ENDDO
ENDIF
DO n = n_start,atoms%ntype,n_stride
CALL mt_to_grid(xcpot, input%jspins, atoms,sphhar,den%mt(:,0:,n,:),nsp,n,grad,ch)
!
! calculate the ex.-cor. potential
CALL xcpot%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),v_xc(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
IF (lda_atom(n)) THEN
! Use local part of pw91 for this atom
CALL xcpot_tmp%get_vxc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),:),v_x(:nsp*atoms%jri(n),:),grad)
!Mix the potentials
divi = 1.0 / (atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(1,n))
nt=0
DO jr=1,atoms%jri(n)
v_xc(nt+1:nt+nsp,:) = ( xcl(nt+1:nt+nsp,:) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
v_xc(nt+1:nt+nsp,:) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
nt=nt+nsp
ENDDO
ENDIF
!Add postprocessing for libxc
IF (l_libxc.AND.xcpot%is_gga()) 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,:))
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_x,vx%mt(:,0:,n,:))
!Add postprocessing for libxc
IF (l_libxc.AND.xcpot%is_gga()) CALL libxc_postprocess_gga_mt(xcpot,atoms,sphhar,n,v_xc,grad)
IF (ALLOCATED(exc%mt)) THEN
!
! calculate the ex.-cor energy density
!
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),e_xc(:nsp*atoms%jri(n),1),grad)
IF (lda_atom(n)) THEN
! Use local part of pw91 for this atom
CALL xcpot_tmp%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),1),grad)
!Mix the potentials
nt=0
DO jr=1,atoms%jri(n)
e_xc(nt+1:nt+nsp,1) = ( xcl(nt+1:nt+nsp,1) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
e_xc(nt+1:nt+nsp,1) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
nt=nt+nsp
END DO
ENDIF
CALL mt_from_grid(atoms,sphhar,nsp,n,1,e_xc,exc%mt(:,0:,n,:))
ENDIF
ENDDO
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_xc,vxc%mt(:,0:,n,:))
CALL mt_from_grid(atoms,sphhar,nsp,n,input%jspins,v_x,vx%mt(:,0:,n,:))
IF (ALLOCATED(exc%mt)) THEN
!
! calculate the ex.-cor energy density
!
CALL xcpot%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),e_xc(:nsp*atoms%jri(n),1),grad)
IF (lda_atom(n)) THEN
! Use local part of pw91 for this atom
CALL xcpot_tmp%get_exc(input%jspins,ch(:nsp*atoms%jri(n),:),xcl(:nsp*atoms%jri(n),1),grad)
!Mix the potentials
nt=0
DO jr=1,atoms%jri(n)
e_xc(nt+1:nt+nsp,1) = ( xcl(nt+1:nt+nsp,1) * ( atoms%rmsh(atoms%jri(n),n) - atoms%rmsh(jr,n) ) +&
e_xc(nt+1:nt+nsp,1) * ( atoms%rmsh(jr,n) - atoms%rmsh(1,n) ) ) * divi
nt=nt+nsp
END DO
ENDIF
CALL mt_from_grid(atoms,sphhar,nsp,n,1,e_xc,exc%mt(:,0:,n,:))
ENDIF
ENDDO
CALL finish_mt_grid()
CALL finish_mt_grid()
#ifdef CPP_MPI
CALL MPI_ALLREDUCE(MPI_IN_PLACE,vx%mt,SIZE(vx%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
CALL MPI_ALLREDUCE(MPI_IN_PLACE,vxc%mt,SIZE(vxc%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
CALL MPI_ALLREDUCE(MPI_IN_PLACE,exc%mt,SIZE(exc%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
CALL MPI_ALLREDUCE(MPI_IN_PLACE,vx%mt,SIZE(vx%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
CALL MPI_ALLREDUCE(MPI_IN_PLACE,vxc%mt,SIZE(vxc%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
CALL MPI_ALLREDUCE(MPI_IN_PLACE,exc%mt,SIZE(exc%mt),CPP_MPI_REAL,MPI_SUM,mpi%mpi_comm,ierr)
#endif
!
RETURN
END SUBROUTINE vmt_xc
!
RETURN
END SUBROUTINE vmt_xc
END MODULE m_vmt_xc
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