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
1730364b
Commit
1730364b
authored
Jul 15, 2019
by
Matthias Redies
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
format all the hybrid code
parent
567d369d
Changes
25
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
25 changed files
with
14807 additions
and
13047 deletions
+14807
-13047
hybrid/HF_init.F90
hybrid/HF_init.F90
+68
-74
hybrid/add_Vnonlocal.F90
hybrid/add_Vnonlocal.F90
+49
-49
hybrid/checkolap.F90
hybrid/checkolap.F90
+306
-308
hybrid/coulombmatrix.F90
hybrid/coulombmatrix.F90
+115
-118
hybrid/exchange_core.F90
hybrid/exchange_core.F90
+714
-734
hybrid/exchange_val_hf.F90
hybrid/exchange_val_hf.F90
+413
-419
hybrid/exponential_integral.f90
hybrid/exponential_integral.f90
+112
-112
hybrid/gen_wavf.F90
hybrid/gen_wavf.F90
+125
-129
hybrid/hf_setup.F90
hybrid/hf_setup.F90
+244
-244
hybrid/hsefunctional.F90
hybrid/hsefunctional.F90
+2502
-2508
hybrid/hsfock.F90
hybrid/hsfock.F90
+173
-173
hybrid/hyb_abcrot.F90
hybrid/hyb_abcrot.F90
+56
-56
hybrid/hybrid.F90
hybrid/hybrid.F90
+127
-128
hybrid/kp_perturbation.F90
hybrid/kp_perturbation.F90
+952
-989
hybrid/mixedbasis.F90
hybrid/mixedbasis.F90
+803
-813
hybrid/olap.F90
hybrid/olap.F90
+393
-412
hybrid/plot_coulombmatrix.F90
hybrid/plot_coulombmatrix.F90
+117
-118
hybrid/read_core.F90
hybrid/read_core.F90
+349
-382
hybrid/spmvec.F90
hybrid/spmvec.F90
+562
-586
hybrid/subvxc.F90
hybrid/subvxc.F90
+199
-202
hybrid/symm_hf.F90
hybrid/symm_hf.F90
+434
-442
hybrid/symmetrizeh.F90
hybrid/symmetrizeh.F90
+517
-518
hybrid/trafo.F90
hybrid/trafo.F90
+1179
-1229
hybrid/wavefproducts.F90
hybrid/wavefproducts.F90
+2217
-2304
hybrid/wrapper.F90
hybrid/wrapper.F90
+2081
-0
No files found.
hybrid/HF_init.F90
View file @
1730364b
MODULE
m_hf_init
!
! preparations for HF and hybrid functional calculation
!
!
! preparations for HF and hybrid functional calculation
!
CONTAINS
SUBROUTINE
hf_init
(
hybrid
,
kpts
,
atoms
,
input
,
DIMENSION
,
hybdat
,
l_real
)
USE
m_types
USE
m_read_core
USE
m_util
USE
m_io_hybrid
IMPLICIT
NONE
TYPE
(
t_hybrid
),
INTENT
(
INOUT
)
::
hybrid
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
TYPE
(
t_hybdat
),
INTENT
(
OUT
)
::
hybdat
LOGICAL
,
INTENT
(
IN
)
::
l_real
INTEGER
::
itype
,
ieq
,
l
,
m
,
i
,
nk
,
l1
,
l2
,
m1
,
m2
,
ok
SUBROUTINE
hf_init
(
hybrid
,
kpts
,
atoms
,
input
,
DIMENSION
,
hybdat
,
l_real
)
USE
m_types
USE
m_read_core
USE
m_util
USE
m_io_hybrid
IMPLICIT
NONE
TYPE
(
t_hybrid
),
INTENT
(
INOUT
)
::
hybrid
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
TYPE
(
t_hybdat
),
INTENT
(
OUT
)
::
hybdat
LOGICAL
,
INTENT
(
IN
)
::
l_real
!initialize hybdat%gridf for radial integration
CALL
intgrf_init
(
atoms
%
ntype
,
atoms
%
jmtd
,
atoms
%
jri
,
atoms
%
dx
,
atoms
%
rmsh
,
hybdat
%
gridf
)
!Alloc variables
ALLOCATE
(
hybdat
%
lmaxc
(
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
bas1
(
atoms
%
jmtd
,
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
bas2
(
atoms
%
jmtd
,
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
bas1_MT
(
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
drbas1_MT
(
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
!sym%tau = oneD%ods%tau
INTEGER
::
itype
,
ieq
,
l
,
m
,
i
,
nk
,
l1
,
l2
,
m1
,
m2
,
ok
! preparations for core states
CALL
core_init
(
dimension
,
input
,
atoms
,
hybdat
%
lmaxcd
,
hybdat
%
maxindxc
)
ALLOCATE
(
hybdat
%
nindxc
(
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
.ne.
0
)
STOP
'eigen_hf: failure allocation hybdat%nindxc'
ALLOCATE
(
hybdat
%
core1
(
atoms
%
jmtd
,
hybdat
%
maxindxc
,
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
.ne.
0
)
STOP
'eigen_hf: failure allocation core1'
ALLOCATE
(
hybdat
%
core2
(
atoms
%
jmtd
,
hybdat
%
maxindxc
,
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
.ne.
0
)
STOP
'eigen_hf: failure allocation core2'
ALLOCATE
(
hybdat
%
eig_c
(
hybdat
%
maxindxc
,
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
.ne.
0
)
STOP
'eigen_hf: failure allocation hybdat%eig_c'
hybdat
%
nindxc
=
0
;
hybdat
%
core1
=
0
;
hybdat
%
core2
=
0
;
hybdat
%
eig_c
=
0
!initialize hybdat%gridf for radial integration
CALL
intgrf_init
(
atoms
%
ntype
,
atoms
%
jmtd
,
atoms
%
jri
,
atoms
%
dx
,
atoms
%
rmsh
,
hybdat
%
gridf
)
! pre-calculate gaunt coefficients
!Alloc variables
ALLOCATE
(
hybdat
%
lmaxc
(
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
bas1
(
atoms
%
jmtd
,
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
bas2
(
atoms
%
jmtd
,
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
bas1_MT
(
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
ALLOCATE
(
hybdat
%
drbas1_MT
(
hybrid
%
maxindx
,
0
:
atoms
%
lmaxd
,
atoms
%
ntype
))
hybdat
%
maxfac
=
max
(
2
*
atoms
%
lmaxd
+
hybrid
%
maxlcutm1
+1
,
2
*
hybdat
%
lmaxcd
+2
*
atoms
%
lmaxd
+1
)
ALLOCATE
(
hybdat
%
fac
(
0
:
hybdat
%
maxfac
),
hybdat
%
sfac
(
0
:
hybdat
%
maxfac
),
stat
=
ok
)
IF
(
ok
.ne.
0
)
STOP
'eigen_hf: failure allocation fac,hybdat%sfac'
hybdat
%
fac
(
0
)
=
1
hybdat
%
sfac
(
0
)
=
1
DO
i
=
1
,
hybdat
%
maxfac
hybdat
%
fac
(
i
)
=
hybdat
%
fac
(
i
-1
)
*
i
! hybdat%fac(i) = i!
hybdat
%
sfac
(
i
)
=
hybdat
%
sfac
(
i
-1
)
*
sqrt
(
i
*
1.0
)
! hybdat%sfac(i) = sqrt(i!)
END
DO
!sym%tau = oneD%ods%tau
! preparations for core states
CALL
core_init
(
dimension
,
input
,
atoms
,
hybdat
%
lmaxcd
,
hybdat
%
maxindxc
)
ALLOCATE
(
hybdat
%
nindxc
(
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation hybdat%nindxc'
ALLOCATE
(
hybdat
%
core1
(
atoms
%
jmtd
,
hybdat
%
maxindxc
,
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation core1'
ALLOCATE
(
hybdat
%
core2
(
atoms
%
jmtd
,
hybdat
%
maxindxc
,
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation core2'
ALLOCATE
(
hybdat
%
eig_c
(
hybdat
%
maxindxc
,
0
:
hybdat
%
lmaxcd
,
atoms
%
ntype
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation hybdat%eig_c'
hybdat
%
nindxc
=
0
;
hybdat
%
core1
=
0
;
hybdat
%
core2
=
0
;
hybdat
%
eig_c
=
0
ALLOCATE
(
hybdat
%
gauntarr
(
2
,
0
:
atoms
%
lmaxd
,
0
:
atoms
%
lmaxd
,
0
:
hybrid
%
maxlcutm1
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
-
hybrid
%
maxlcutm1
:
hybrid
%
maxlcutm1
),
stat
=
ok
)
IF
(
ok
.ne.
0
)
STOP
'eigen: failure allocation hybdat%gauntarr'
hybdat
%
gauntarr
=
0
DO
l2
=
0
,
atoms
%
lmaxd
DO
l1
=
0
,
atoms
%
lmaxd
DO
l
=
abs
(
l1
-
l2
),
min
(
l1
+
l2
,
hybrid
%
maxlcutm1
)
DO
m
=
-
l
,
l
DO
m1
=
-
l1
,
l1
m2
=
m1
+
m
! Gaunt condition -m1+m2-m = 0
IF
(
abs
(
m2
)
.le.
l2
)
hybdat
%
gauntarr
(
1
,
l1
,
l2
,
l
,
m1
,
m
)
=
gaunt
(
l1
,
l2
,
l
,
m1
,
m2
,
m
,
hybdat
%
maxfac
,
hybdat
%
fac
,
hybdat
%
sfac
)
m2
=
m1
-
m
! switch role of l2-index
IF
(
abs
(
m2
)
.le.
l2
)
hybdat
%
gauntarr
(
2
,
l1
,
l2
,
l
,
m1
,
m
)
=
gaunt
(
l2
,
l1
,
l
,
m2
,
m1
,
m
,
hybdat
%
maxfac
,
hybdat
%
fac
,
hybdat
%
sfac
)
END
DO
END
DO
END
DO
END
DO
END
DO
! pre-calculate gaunt coefficients
!skip_kpt = .false.
hybdat
%
maxfac
=
max
(
2
*
atoms
%
lmaxd
+
hybrid
%
maxlcutm1
+
1
,
2
*
hybdat
%
lmaxcd
+
2
*
atoms
%
lmaxd
+
1
)
ALLOCATE
(
hybdat
%
fac
(
0
:
hybdat
%
maxfac
),
hybdat
%
sfac
(
0
:
hybdat
%
maxfac
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen_hf: failure allocation fac,hybdat%sfac'
hybdat
%
fac
(
0
)
=
1
hybdat
%
sfac
(
0
)
=
1
DO
i
=
1
,
hybdat
%
maxfac
hybdat
%
fac
(
i
)
=
hybdat
%
fac
(
i
-
1
)
*
i
! hybdat%fac(i) = i!
hybdat
%
sfac
(
i
)
=
hybdat
%
sfac
(
i
-
1
)
*
sqrt
(
i
*
1.0
)
! hybdat%sfac(i) = sqrt(i!)
END
DO
END
SUBROUTINE
hf_init
ALLOCATE
(
hybdat
%
gauntarr
(
2
,
0
:
atoms
%
lmaxd
,
0
:
atoms
%
lmaxd
,
0
:
hybrid
%
maxlcutm1
,
-
atoms
%
lmaxd
:
atoms
%
lmaxd
,
-
hybrid
%
maxlcutm1
:
hybrid
%
maxlcutm1
),
stat
=
ok
)
IF
(
ok
/
=
0
)
STOP
'eigen: failure allocation hybdat%gauntarr'
hybdat
%
gauntarr
=
0
DO
l2
=
0
,
atoms
%
lmaxd
DO
l1
=
0
,
atoms
%
lmaxd
DO
l
=
abs
(
l1
-
l2
),
min
(
l1
+
l2
,
hybrid
%
maxlcutm1
)
DO
m
=
-
l
,
l
DO
m1
=
-
l1
,
l1
m2
=
m1
+
m
! Gaunt condition -m1+m2-m = 0
IF
(
abs
(
m2
)
<=
l2
)
hybdat
%
gauntarr
(
1
,
l1
,
l2
,
l
,
m1
,
m
)
=
gaunt
(
l1
,
l2
,
l
,
m1
,
m2
,
m
,
hybdat
%
maxfac
,
hybdat
%
fac
,
hybdat
%
sfac
)
m2
=
m1
-
m
! switch role of l2-index
IF
(
abs
(
m2
)
<=
l2
)
hybdat
%
gauntarr
(
2
,
l1
,
l2
,
l
,
m1
,
m
)
=
gaunt
(
l2
,
l1
,
l
,
m2
,
m1
,
m
,
hybdat
%
maxfac
,
hybdat
%
fac
,
hybdat
%
sfac
)
END
DO
END
DO
END
DO
END
DO
END
DO
!skip_kpt = .false.
END
SUBROUTINE
hf_init
END
MODULE
m_hf_init
hybrid/add_Vnonlocal.F90
View file @
1730364b
...
...
@@ -40,95 +40,95 @@ MODULE m_add_vnonlocal
! c
! M.Betzinger (09/07) c
! c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c c
CONTAINS
CONTAINS
SUBROUTINE
add_vnonlocal
(
nk
,
lapw
,
atoms
,
hybrid
,
dimension
,
kpts
,
jsp
,
results
,
xcpot
,
noco
,
hmat
)
SUBROUTINE
add_vnonlocal
(
nk
,
lapw
,
atoms
,
hybrid
,
dimension
,
kpts
,
jsp
,
results
,
xcpot
,
noco
,
hmat
)
USE
m_symm_hf
,
ONLY
:
symm_hf
USE
m_util
,
ONLY
:
intgrf
,
intgrf_init
USE
m_symm_hf
,
ONLY
:
symm_hf
USE
m_util
,
ONLY
:
intgrf
,
intgrf_init
USE
m_exchange_valence_hf
USE
m_exchange_core
USE
m_symmetrizeh
USE
m_wrapper
USE
m_hsefunctional
,
ONLY
:
exchange_vccvHSE
,
exchange_ccccHSE
USE
m_hsefunctional
,
ONLY
:
exchange_vccvHSE
,
exchange_ccccHSE
USE
m_types
USE
m_io_hybrid
IMPLICIT
NONE
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
CLASS
(
t_xcpot
),
INTENT
(
IN
)
::
xcpot
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_hybrid
),
INTENT
(
INOUT
)
::
hybrid
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_mat
),
INTENT
(
INOUT
)
::
hmat
INTEGER
,
INTENT
(
IN
)
::
jsp
INTEGER
,
INTENT
(
IN
)
::
nk
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
CLASS
(
t_xcpot
),
INTENT
(
IN
)
::
xcpot
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_hybrid
),
INTENT
(
INOUT
)
::
hybrid
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_lapw
),
INTENT
(
IN
)
::
lapw
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_mat
),
INTENT
(
INOUT
)
::
hmat
INTEGER
,
INTENT
(
IN
)
::
jsp
INTEGER
,
INTENT
(
IN
)
::
nk
! local scalars
INTEGER
::
n
,
nn
,
iband
,
nbasfcn
INTEGER
::
n
,
nn
,
iband
,
nbasfcn
REAL
::
a_ex
TYPE
(
t_mat
)
::
olap
,
tmp
,
v_x
,
z
COMPLEX
::
exch
(
dimension
%
neigd
,
dimension
%
neigd
)
TYPE
(
t_mat
)
::
olap
,
tmp
,
v_x
,
z
COMPLEX
::
exch
(
dimension
%
neigd
,
dimension
%
neigd
)
! initialize weighting factor for HF exchange part
a_ex
=
xcpot
%
get_exchange_weight
()
a_ex
=
xcpot
%
get_exchange_weight
()
nbasfcn
=
MERGE
(
lapw
%
nv
(
1
)
+
lapw
%
nv
(
2
)
+2
*
atoms
%
nlotot
,
lapw
%
nv
(
1
)
+
atoms
%
nlotot
,
noco
%
l_noco
)
CALL
v_x
%
init
(
hmat
%
l_real
,
nbasfcn
,
nbasfcn
)
nbasfcn
=
MERGE
(
lapw
%
nv
(
1
)
+
lapw
%
nv
(
2
)
+
2
*
atoms
%
nlotot
,
lapw
%
nv
(
1
)
+
atoms
%
nlotot
,
noco
%
l_noco
)
CALL
v_x
%
init
(
hmat
%
l_real
,
nbasfcn
,
nbasfcn
)
CALL
read_v_x
(
v_x
,
kpts
%
nkpt
*
(
jsp
-1
)
+
nk
)
CALL
read_v_x
(
v_x
,
kpts
%
nkpt
*
(
jsp
-
1
)
+
nk
)
! add non-local x-potential to the hamiltonian hmat
DO
n
=
1
,
v_x
%
matsize1
DO
nn
=
1
,
n
DO
nn
=
1
,
n
IF
(
hmat
%
l_real
)
THEN
hmat
%
data_r
(
nn
,
n
)
=
hmat
%
data_r
(
nn
,
n
)
-
a_ex
*
v_x
%
data_r
(
nn
,
n
)
hmat
%
data_r
(
nn
,
n
)
=
hmat
%
data_r
(
nn
,
n
)
-
a_ex
*
v_x
%
data_r
(
nn
,
n
)
ELSE
hmat
%
data_c
(
nn
,
n
)
=
hmat
%
data_c
(
nn
,
n
)
-
a_ex
*
v_x
%
data_c
(
nn
,
n
)
hmat
%
data_c
(
nn
,
n
)
=
hmat
%
data_c
(
nn
,
n
)
-
a_ex
*
v_x
%
data_c
(
nn
,
n
)
ENDIF
END
DO
END
DO
! calculate HF energy
IF
(
hybrid
%
l_calhf
)
THEN
WRITE
(
6
,
'(A)'
)
new_line
(
'n'
)//
new_line
(
'n'
)//
' ### '
//
' diagonal HF exchange elements (eV) ###'
WRITE
(
6
,
'(A)'
)
new_line
(
'n'
)
//
' k-point '
//
'band tail pole total(valence+core)'
IF
(
hybrid
%
l_calhf
)
THEN
WRITE
(
6
,
'(A)'
)
new_line
(
'n'
)//
new_line
(
'n'
)//
' ### '
//
' diagonal HF exchange elements (eV) ###'
WRITE
(
6
,
'(A)'
)
new_line
(
'n'
)//
' k-point '
//
'band tail pole total(valence+core)'
END
IF
! read in lower triangle part of overlap matrix from direct acces file olap
CALL
olap
%
init
(
hmat
%
l_real
,
nbasfcn
,
nbasfcn
)
CALL
read_olap
(
olap
,
kpts
%
nkpt
*
(
jsp
-1
)
+
nk
)
IF
(
.NOT.
olap
%
l_real
)
olap
%
data_c
=
conjg
(
olap
%
data_c
)
CALL
olap
%
init
(
hmat
%
l_real
,
nbasfcn
,
nbasfcn
)
CALL
read_olap
(
olap
,
kpts
%
nkpt
*
(
jsp
-
1
)
+
nk
)
IF
(
.NOT.
olap
%
l_real
)
olap
%
data_c
=
conjg
(
olap
%
data_c
)
CALL
z
%
init
(
olap
%
l_real
,
nbasfcn
,
dimension
%
neigd
)
CALL
z
%
init
(
olap
%
l_real
,
nbasfcn
,
dimension
%
neigd
)
CALL
read_z
(
z
,
kpts
%
nkpt
*
(
jsp
-
1
)
+
nk
)
CALL
read_z
(
z
,
kpts
%
nkpt
*
(
jsp
-1
)
+
nk
)
! calculate exchange contribution of current k-point nk to total energy (te_hfex)
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen.F90
IF
(
.NOT.
v_x
%
l_real
)
v_x
%
data_c
=
conjg
(
v_x
%
data_c
)
! in the case of a spin-unpolarized calculation the factor 2 is added in eigen.F90
IF
(
.NOT.
v_x
%
l_real
)
v_x
%
data_c
=
conjg
(
v_x
%
data_c
)
exch
=
0
z
%
matsize1
=
MIN
(
z
%
matsize1
,
v_x
%
matsize2
)
z
%
matsize1
=
MIN
(
z
%
matsize1
,
v_x
%
matsize2
)
CALL
v_x
%
multiply
(
z
,
tmp
)
CALL
v_x
%
multiply
(
z
,
tmp
)
DO
iband
=
1
,
hybrid
%
nbands
(
nk
)
IF
(
z
%
l_real
)
THEN
exch
(
iband
,
iband
)
=
dot_product
(
z
%
data_r
(:
z
%
matsize1
,
iband
),
tmp
%
data_r
(:,
iband
))
exch
(
iband
,
iband
)
=
dot_product
(
z
%
data_r
(:
z
%
matsize1
,
iband
),
tmp
%
data_r
(:,
iband
))
ELSE
exch
(
iband
,
iband
)
=
dot_product
(
z
%
data_c
(:
z
%
matsize1
,
iband
),
tmp
%
data_c
(:,
iband
))
exch
(
iband
,
iband
)
=
dot_product
(
z
%
data_c
(:
z
%
matsize1
,
iband
),
tmp
%
data_c
(:,
iband
))
END
IF
IF
(
iband
.LE.
hybrid
%
nobd
(
nk
))
THEN
results
%
te_hfex
%
valence
=
results
%
te_hfex
%
valence
-
a_ex
*
results
%
w_iks
(
iband
,
nk
,
jsp
)
*
exch
(
iband
,
iband
)
IF
(
iband
<=
hybrid
%
nobd
(
nk
))
THEN
results
%
te_hfex
%
valence
=
results
%
te_hfex
%
valence
-
a_ex
*
results
%
w_iks
(
iband
,
nk
,
jsp
)
*
exch
(
iband
,
iband
)
END
IF
IF
(
hybrid
%
l_calhf
)
THEN
WRITE
(
6
,
'(
''
(
''
,F5.3,
''
,
''
,F5.3,
''
,
''
,F5.3,
''
)
''
,I4,4X,3F15.5)'
)
&
kpts
%
bkf
(:,
nk
),
iband
,
(
REAL
(
exch
(
iband
,
iband
))
-
hybrid
%
div_vv
(
iband
,
nk
,
jsp
))
*
(
-27.211608
),
&
hybrid
%
div_vv
(
iband
,
nk
,
jsp
)
*
(
-27.211608
),
REAL
(
exch
(
iband
,
iband
))
*
(
-27.211608
)
IF
(
hybrid
%
l_calhf
)
THEN
WRITE
(
6
,
'(
''
(
''
,F5.3,
''
,
''
,F5.3,
''
,
''
,F5.3,
''
)
''
,I4,4X,3F15.5)'
)
&
kpts
%
bkf
(:,
nk
),
iband
,
(
REAL
(
exch
(
iband
,
iband
))
-
hybrid
%
div_vv
(
iband
,
nk
,
jsp
))
*
(
-27.211608
),
&
hybrid
%
div_vv
(
iband
,
nk
,
jsp
)
*
(
-27.211608
),
REAL
(
exch
(
iband
,
iband
))
*
(
-27.211608
)
END
IF
END
DO
END
SUBROUTINE
add_vnonlocal
...
...
hybrid/checkolap.F90
View file @
1730364b
This diff is collapsed.
Click to expand it.
hybrid/coulombmatrix.F90
View file @
1730364b
This diff is collapsed.
Click to expand it.
hybrid/exchange_core.F90
View file @
1730364b
This diff is collapsed.
Click to expand it.
hybrid/exchange_val_hf.F90
View file @
1730364b
This diff is collapsed.
Click to expand it.
hybrid/exponential_integral.f90
View file @
1730364b
...
...
@@ -2,120 +2,120 @@
! [1] Tseng, Lee, Journal of Hydrology, 205 (1998) 38-51
module
m_exponential_integral
implicit
none
real
,
parameter
::
series_laguerre
=
4.0
implicit
none
real
,
parameter
::
series_laguerre
=
4.0
contains
! Calculate the exponential integral E_1(x):
!
! inf
! / -t
! | e
! E (x) = | dt -----
! 1 | t
! /
! x
!
! Input: arg - position at which exponential integral is evaluated (arg > 0)
! Output: res - E_1(arg)
pure
subroutine
calculateExponentialIntegral
(
arg
,
res
)
implicit
none
real
,
intent
(
in
)
::
arg
real
,
intent
(
out
)
::
res
! For arguments smaller than 4 the series expansion is used
if
(
arg
<
series_laguerre
)
then
res
=
seriesExpansion
(
arg
)
! otherwise a Gauss-Laguerre expansion is better
else
res
=
exp
(
-
arg
)
*
gauss_laguerre
(
arg
)
endif
end
subroutine
calculateExponentialIntegral
! Series expansion of the exponential integral
!
! n_cut
! ----- n n
! \ (-1) x
! E (x) = -gamma - ln(x) - ) --------
! 1 / n * n!
! -----
! n = 1
!
! where gamma is the Euler constant.
! n_cut is set to 25
! Input: arg - argument for which the exponential integral is approximated
! Return: approximation by series expansion for E_1(arg)
pure
real
function
seriesExpansion
(
arg
)
implicit
none
real
,
intent
(
in
)
::
arg
real
::
res
,
fact
! result of the summation, 1 / n
integer
::
i
! counter variable
real
,
parameter
::
EULER_GAMMA
=
0.57721566490153286060651209008241
! Euler constant
integer
,
parameter
::
ITERATION
=
25
! Cutoff for series expansion
! initialize summation result
res
=
0.0
! perform the summation
do
i
=
ITERATION
,
2
,
-1
! calculate 1/n
fact
=
1.0
/
i
! add next term of summation
res
=
arg
*
fact
*
(
fact
-
res
)
end
do
! calculate the final result
seriesExpansion
=
-
EULER_GAMMA
-
log
(
arg
)
+
arg
*
(
1.0
-
res
)
end
function
seriesExpansion
! The Gauss Laguerre expansion of the exponential integral can be written as
!
! N
! E (arg) ----- a
! 1 \ n
! ------- = ) --------
! -arg / x + arg
! e ----- n
! n=1
!
! where the a_n and x_n are determined by least quadrature and are given in [1]
! Input: arg - point at which Gaussian Laguerre quadrature is calculated
! Return: E_1(arg) in this approximation
pure
real
function
gauss_laguerre
(
arg
)
implicit
none
real
,
intent
(
in
)
::
arg
! the quadrature constants a_n and x_n from [1]
real
,
parameter
::
a
(
1
:
15
)
=
(/
&
0.2182348859400869e+00
,
0.3422101779228833e+00
,
0.2630275779416801e+00
,
&
0.1264258181059305e+00
,
0.4020686492100091e-01
,
0.8563877803611838e-02
,
&
0.1212436147214252e-02
,
0.1116743923442519e-03
,
0.6459926762022901e-05
,
&
0.2226316907096273e-06
,
0.4227430384979365e-08
,
0.3921897267041089e-10
,
&
0.1456515264073126e-12
,
0.1483027051113301e-15
,
0.1600594906211133e-19
/)
real
,
parameter
::
x
(
1
:
15
)
=
(/
&
0.9330781201728180e-01
,
0.4926917403018839e+00
,
0.1215595412070949e+01
,
&
0.2269949526203743e+01
,
0.3667622721751437e+01
,
0.5425336627413553e+01
,
&
0.7565916226613068e+01
,
0.1012022856801911e+02
,
0.1313028248217572e+02
,
&
0.1665440770832996e+02
,
0.2077647889944877e+02
,
0.2562389422672878e+02
,
&
0.3140751916975394e+02
,
0.3853068330648601e+02
,
0.4802608557268579e+02
/)
! Calculate the summation
gauss_laguerre
=
sum
(
a
/
(
x
+
arg
)
)
end
function
gauss_laguerre
! Calculate the exponential integral E_1(x):
!
! inf
! / -t
! | e
! E (x) = | dt -----
! 1 | t
! /
! x
!
! Input: arg - position at which exponential integral is evaluated (arg > 0)
! Output: res - E_1(arg)
pure
subroutine
calculateExponentialIntegral
(
arg
,
res
)
implicit
none
real
,
intent
(
in
)
::
arg
real
,
intent
(
out
)
::
res
! For arguments smaller than 4 the series expansion is used
if
(
arg
<
series_laguerre
)
then
res
=
seriesExpansion
(
arg
)
! otherwise a Gauss-Laguerre expansion is better
else
res
=
exp
(
-
arg
)
*
gauss_laguerre
(
arg
)
endif
end
subroutine
calculateExponentialIntegral
! Series expansion of the exponential integral
!
! n_cut
! ----- n n
! \ (-1) x
! E (x) = -gamma - ln(x) - ) --------
! 1 / n * n!
! -----
! n = 1
!
! where gamma is the Euler constant.
! n_cut is set to 25
! Input: arg - argument for which the exponential integral is approximated
! Return: approximation by series expansion for E_1(arg)
pure
real
function
seriesExpansion
(
arg
)
implicit
none
real
,
intent
(
in
)
::
arg
real
::
res
,
fact
! result of the summation, 1 / n
integer
::
i
! counter variable
real
,
parameter
::
EULER_GAMMA
=
0.57721566490153286060651209008241
! Euler constant
integer
,
parameter
::
ITERATION
=
25
! Cutoff for series expansion
! initialize summation result
res
=
0.0
! perform the summation
do
i
=
ITERATION
,
2
,
-1
! calculate 1/n
fact
=
1.0
/
i
! add next term of summation
res
=
arg
*
fact
*
(
fact
-
res
)
end
do
! calculate the final result
seriesExpansion
=
-
EULER_GAMMA
-
log
(
arg
)
+
arg
*
(
1.0
-
res
)
end
function
seriesExpansion
! The Gauss Laguerre expansion of the exponential integral can be written as
!
! N
! E (arg) ----- a
! 1 \ n
! ------- = ) --------
! -arg / x + arg
! e ----- n
! n=1
!
! where the a_n and x_n are determined by least quadrature and are given in [1]
! Input: arg - point at which Gaussian Laguerre quadrature is calculated
! Return: E_1(arg) in this approximation
pure
real
function
gauss_laguerre
(
arg
)
implicit
none
real
,
intent
(
in
)
::
arg
! the quadrature constants a_n and x_n from [1]
real
,
parameter
::
a
(
1
:
15
)
=
(/
&
0.2182348859400869e+00
,
0.3422101779228833e+00
,
0.2630275779416801e+00
,
&
0.1264258181059305e+00
,
0.4020686492100091e-01
,
0.8563877803611838e-02
,
&
0.1212436147214252e-02
,
0.1116743923442519e-03
,
0.6459926762022901e-05
,
&
0.2226316907096273e-06
,
0.4227430384979365e-08
,
0.3921897267041089e-10
,
&
0.1456515264073126e-12
,
0.1483027051113301e-15
,
0.1600594906211133e-19
/)
real
,
parameter
::
x
(
1
:
15
)
=
(/
&
0.9330781201728180e-01
,
0.4926917403018839e+00
,
0.1215595412070949e+01
,
&
0.2269949526203743e+01
,
0.3667622721751437e+01
,
0.5425336627413553e+01
,
&
0.7565916226613068e+01
,
0.1012022856801911e+02
,
0.1313028248217572e+02
,
&
0.1665440770832996e+02
,
0.2077647889944877e+02
,
0.2562389422672878e+02
,
&
0.3140751916975394e+02
,
0.3853068330648601e+02
,
0.4802608557268579e+02
/)
! Calculate the summation
gauss_laguerre
=
sum
(
a
/(
x
+
arg
)
)
end
function
gauss_laguerre
end
module
m_exponential_integral
hybrid/gen_wavf.F90
View file @
1730364b
...
...
@@ -10,22 +10,22 @@
! and writes them out in cmt and z, respectively. !
! M.Betzinger(09/07) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE
m_gen_wavf
CONTAINS
SUBROUTINE
gen_wavf
(
nkpti
,
kpts
,
it
,
sym
,
atoms
,
el_eig
,
ello_eig
,
cell
,
dimension
,
hybrid
,
vr0
,
&
hybdat
,
noco
,
oneD
,
mpi
,
input
,
jsp
,
zmat
)
SUBROUTINE
gen_wavf
(
nkpti
,
kpts
,
it
,
sym
,
atoms
,
el_eig
,
ello_eig
,
cell
,
dimension
,
hybrid
,
vr0
,
&
hybdat
,
noco
,
oneD
,
mpi
,
input
,
jsp
,
zmat
)
! nkpti :: number of irreducible k-points
! nkpt :: number of all k-points
! nkpt :: number of all k-points
USE
m_radfun
USE
m_radflo
USE
m_abcof
USE
m_trafo
,
ONLY
:
waveftrafo_genwavf
USE
m_util
,
ONLY
:
modulo1
USE
m_trafo
,
ONLY
:
waveftrafo_genwavf
USE
m_util
,
ONLY
:
modulo1