Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
51
Issues
51
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
643a3f97
Commit
643a3f97
authored
Oct 02, 2018
by
Matthias Redies
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
fix indentanion, so merges work
parent
2347d607
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
189 additions
and
191 deletions
+189
-191
vgen/vis_xc.F90
vgen/vis_xc.F90
+60
-60
vgen/vmt_xc.F90
vgen/vmt_xc.F90
+129
-131
No files found.
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
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment