Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
57
Issues
57
List
Boards
Labels
Milestones
Packages
Packages
Container Registry
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
d970cdc8
Commit
d970cdc8
authored
Apr 25, 2018
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
More subroutines for the t_force type
parent
74cf9fcc
Changes
11
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
307 additions
and
236 deletions
+307
-236
cdn/cdnval.F90
cdn/cdnval.F90
+53
-69
cmake/Files_and_Targets.txt
cmake/Files_and_Targets.txt
+2
-1
eigen/tlmplm_store.F90
eigen/tlmplm_store.F90
+1
-1
force/force_a12.f90
force/force_a12.f90
+15
-8
force/force_a21.F90
force/force_a21.F90
+37
-30
force/force_a21_U.f90
force/force_a21_U.f90
+17
-14
force/force_a21_lo.f90
force/force_a21_lo.f90
+21
-16
types/CMakeLists.txt
types/CMakeLists.txt
+2
-0
types/types.F90
types/types.F90
+1
-0
types/types_cdnval.f90
types/types_cdnval.f90
+1
-97
types/types_force.f90
types/types_force.f90
+157
-0
No files found.
cdn/cdnval.F90
View file @
d970cdc8
This diff is collapsed.
Click to expand it.
cmake/Files_and_Targets.txt
View file @
d970cdc8
...
...
@@ -55,7 +55,8 @@ eigen/vec_for_lo.f90 eigen/orthoglo.F90 juDFT/usage_data.F90
global/enpara.f90 global/chkmt.f90 inpgen/inpgen.f90 inpgen/set_inp.f90 inpgen/inpgen_help.f90 io/rw_inp.f90 juDFT/juDFT.F90 global/find_enpara.f90
juDFT/info.F90 juDFT/stop.F90 juDFT/args.F90 juDFT/time.F90 juDFT/init.F90 juDFT/sysinfo.F90 io/w_inpXML.f90 init/julia.f90 global/utility.F90
init/compile_descr.F90 init/kpoints.f90 io/xmlOutput.F90 init/brzone2.f90 cdn/slab_dim.f90 cdn/slabgeom.f90 dos/nstm3.f90 cdn/int_21.f90
cdn/int_21lo.f90 cdn_mt/rhomt21.f90 cdn_mt/rhonmt21.f90)
cdn/int_21lo.f90 cdn_mt/rhomt21.f90 cdn_mt/rhonmt21.f90 force/force_a21.F90 force/force_a21_lo.f90 force/force_a21_U.f90 force/force_a12.f90
eigen/tlmplm_store.F90)
set(fleur_SRC ${fleur_F90} ${fleur_F77})
...
...
eigen/tlmplm_store.F90
View file @
d970cdc8
...
...
@@ -9,7 +9,7 @@ MODULE m_tlmplm_store
! used to transfer the results from tlmplm&density matrix in case of lda+u from eigen
! into force_a21
! D.W 2014
USE
m_types
USE
m_types
_tlmplm
IMPLICIT
NONE
PRIVATE
TYPE
(
t_tlmplm
)
::
td_stored
...
...
force/force_a12.f90
View file @
d970cdc8
...
...
@@ -6,13 +6,15 @@ MODULE m_forcea12
!
CONTAINS
SUBROUTINE
force_a12
(
atoms
,
nobd
,
sym
,
DIMENSION
,
cell
,
oneD
,&
we
,
jsp
,
ne
,
usdus
,
eigVecCoeffs
,
force
,
results
)
USE
m_types
we
,
jsp
,
ne
,
usdus
,
eigVecCoeffs
,
acoflo
,
bcoflo
,
e1cof
,
e2cof
,
f_a12
,
results
)
USE
m_types_setup
USE
m_types_misc
USE
m_types_usdus
USE
m_types_cdnval
USE
m_constants
USE
m_juDFT
IMPLICIT
NONE
TYPE
(
t_force
),
INTENT
(
INOUT
)
::
force
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
...
...
@@ -27,7 +29,12 @@ CONTAINS
INTEGER
,
INTENT
(
IN
)
::
ne
,
jsp
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
we
(
nobd
)
REAL
,
INTENT
(
IN
)
::
we
(
nobd
)
COMPLEX
,
INTENT
(
IN
)
::
acoflo
(
-
atoms
%
llod
:
atoms
%
llod
,
ne
,
atoms
%
nlod
,
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
bcoflo
(
-
atoms
%
llod
:
atoms
%
llod
,
ne
,
atoms
%
nlod
,
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
e1cof
(
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
e2cof
(
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
INOUT
)
::
f_a12
(
3
,
atoms
%
ntype
)
! ..
! .. Local Scalars ..
COMPLEX
a12
,
cil1
,
cil2
...
...
@@ -87,8 +94,8 @@ CONTAINS
DO
m1
=
-
l1
,
l1
lm1
=
l1
*
(
l1
+1
)
+
m1
DO
ie
=
1
,
ne
acof_flapw
(
ie
,
lm1
)
=
acof_flapw
(
ie
,
lm1
)
-
force
%
acoflo
(
m1
,
ie
,
ilo
,
natrun
)
bcof_flapw
(
ie
,
lm1
)
=
bcof_flapw
(
ie
,
lm1
)
-
force
%
bcoflo
(
m1
,
ie
,
ilo
,
natrun
)
acof_flapw
(
ie
,
lm1
)
=
acof_flapw
(
ie
,
lm1
)
-
acoflo
(
m1
,
ie
,
ilo
,
natrun
)
bcof_flapw
(
ie
,
lm1
)
=
bcof_flapw
(
ie
,
lm1
)
-
bcoflo
(
m1
,
ie
,
ilo
,
natrun
)
ENDDO
ENDDO
ENDDO
...
...
@@ -107,7 +114,7 @@ CONTAINS
!
a12
=
a12
+
CONJG
(
cil1
*
&
(
acof_flapw
(
ie
,
lm1
)
*
usdus
%
us
(
l1
,
n
,
jsp
)
+
bcof_flapw
(
ie
,
lm1
)
*
usdus
%
uds
(
l1
,
n
,
jsp
)
))
*
cil2
*
&
(
force
%
e1cof
(
ie
,
lm2
,
natrun
)
*
usdus
%
us
(
l2
,
n
,
jsp
)
+
force
%
e2cof
(
ie
,
lm2
,
natrun
)
*
usdus
%
uds
(
l2
,
n
,
jsp
))
*
we
(
ie
)
(
e1cof
(
ie
,
lm2
,
natrun
)
*
usdus
%
us
(
l2
,
n
,
jsp
)
+
e2cof
(
ie
,
lm2
,
natrun
)
*
usdus
%
uds
(
l2
,
n
,
jsp
))
*
we
(
ie
)
END
DO
aaa
(
1
)
=
alpha
(
l1
,
m1
)
*
krondel
(
l2
,
l1
-1
)
*
krondel
(
m2
,
m1
+1
)
...
...
@@ -224,7 +231,7 @@ CONTAINS
! is also a solution of Schr. equ. if psi is one.
DO
i
=
1
,
3
results
%
force
(
i
,
n
,
jsp
)
=
results
%
force
(
i
,
n
,
jsp
)
+
REAL
(
forc_a12
(
i
))
f
orce
%
f_a12
(
i
,
n
)
=
force
%
f_a12
(
i
,
n
)
+
forc_a12
(
i
)
f
_a12
(
i
,
n
)
=
f_a12
(
i
,
n
)
+
forc_a12
(
i
)
END
DO
!
! write result moved to force_a8
...
...
force/force_a21.F90
View file @
d970cdc8
MODULE
m_forcea21
CONTAINS
SUBROUTINE
force_a21
(
input
,
atoms
,
DIMENSION
,
nobd
,
sym
,
oneD
,
cell
,&
we
,
jsp
,
epar
,
ne
,
eig
,
usdus
,
eigVecCoeffs
,
force
,
results
)
SUBROUTINE
force_a21
(
input
,
atoms
,
DIMENSION
,
sym
,
oneD
,
cell
,&
we
,
jsp
,
epar
,
ne
,
eig
,
usdus
,
eigVecCoeffs
,
aveccof
,
bveccof
,
cveccof
,
f_a21
,
f_b4
,
results
)
! ************************************************************
! Pulay 2nd and 3rd (A17+A20) term force contribution a la Rici
...
...
@@ -24,12 +24,15 @@ CONTAINS
USE
m_forcea21lo
USE
m_forcea21U
USE
m_tlmplm_store
USE
m_types
USE
m_types_setup
USE
m_types_misc
USE
m_types_usdus
USE
m_types_tlmplm
USE
m_types_cdnval
USE
m_constants
USE
m_juDFT
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_force
),
INTENT
(
INOUT
)
::
force
TYPE
(
t_results
),
INTENT
(
INOUT
)
::
results
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
DIMENSION
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
...
...
@@ -40,12 +43,16 @@ CONTAINS
TYPE
(
t_eigVecCoeffs
),
INTENT
(
IN
)
::
eigVecCoeffs
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
nobd
INTEGER
,
INTENT
(
IN
)
::
ne
,
jsp
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
we
(
nobd
),
epar
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
REAL
,
INTENT
(
IN
)
::
eig
(
DIMENSION
%
neigd
)
REAL
,
INTENT
(
IN
)
::
we
(
ne
),
epar
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
)
REAL
,
INTENT
(
IN
)
::
eig
(
DIMENSION
%
neigd
)
COMPLEX
,
INTENT
(
IN
)
::
aveccof
(
3
,
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
bveccof
(
3
,
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
cveccof
(
3
,
-
atoms
%
llod
:
atoms
%
llod
,
ne
,
atoms
%
nlod
,
atoms
%
nat
)
COMPLEX
,
INTENT
(
INOUT
)
::
f_a21
(
3
,
atoms
%
ntype
)
COMPLEX
,
INTENT
(
INOUT
)
::
f_b4
(
3
,
atoms
%
ntype
)
! ..
! .. Local Scalars ..
COMPLEX
dtd
,
dtu
,
utd
,
utu
...
...
@@ -145,10 +152,10 @@ CONTAINS
END
IF
DO
i
=
1
,
3
a21
(
i
,
natrun
)
=
a21
(
i
,
natrun
)
+
2.0
*
&
AIMAG
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utu
*
force
%
aveccof
(
i
,
ie
,
lm2
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utd
*
force
%
bveccof
(
i
,
ie
,
lm2
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtu
*
force
%
aveccof
(
i
,
ie
,
lm2
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtd
*
force
%
bveccof
(
i
,
ie
,
lm2
,
natrun
))
*
we
(
ie
)/
atoms
%
neq
(
n
)
AIMAG
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utu
*
aveccof
(
i
,
ie
,
lm2
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utd
*
bveccof
(
i
,
ie
,
lm2
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtu
*
aveccof
(
i
,
ie
,
lm2
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtd
*
bveccof
(
i
,
ie
,
lm2
,
natrun
))
*
we
(
ie
)/
atoms
%
neq
(
n
)
! END i loop
END
DO
END
IF
...
...
@@ -175,10 +182,10 @@ CONTAINS
DO
i
=
1
,
3
DO
natrun
=
natom
,
natom
+
atoms
%
neq
(
n
)
-
1
a21
(
i
,
natrun
)
=
a21
(
i
,
natrun
)
+
2.0
*
&
AIMAG
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utu
*
force
%
aveccof
(
i
,
ie
,
lm1
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utd
*
force
%
bveccof
(
i
,
ie
,
lm1
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtu
*
force
%
aveccof
(
i
,
ie
,
lm1
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtd
*
force
%
bveccof
(
i
,
ie
,
lm1
,
natrun
)&
AIMAG
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utu
*
aveccof
(
i
,
ie
,
lm1
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
))
*
utd
*
bveccof
(
i
,
ie
,
lm1
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtu
*
aveccof
(
i
,
ie
,
lm1
,
natrun
)&
+
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
))
*
dtd
*
bveccof
(
i
,
ie
,
lm1
,
natrun
)&
)
*
we
(
ie
)
/
atoms
%
neq
(
n
)
END
DO
!
...
...
@@ -194,10 +201,10 @@ CONTAINS
!
!---> add the local orbital and U contribution to a21
!
CALL
force_a21_lo
(
nobd
,
atoms
,
jsp
,
n
,
we
,
eig
,
ne
,
eigVecCoeffs
,
force
,
tlmplm
,
usdus
,
a21
)
CALL
force_a21_lo
(
atoms
,
jsp
,
n
,
we
,
eig
,
ne
,
eigVecCoeffs
,
aveccof
,
bveccof
,
cveccof
,
tlmplm
,
usdus
,
a21
)
IF
((
atoms
%
n_u
.GT.
0
)
.AND.
(
i_u
.LE.
atoms
%
n_u
))
THEN
CALL
force_a21_U
(
nobd
,
atoms
,
i_u
,
n
,
jsp
,
we
,
ne
,
usdus
,
v_mmp
,
eigVecCoeffs
,
force
,
a21
)
CALL
force_a21_U
(
atoms
,
i_u
,
n
,
jsp
,
we
,
ne
,
usdus
,
v_mmp
,
eigVecCoeffs
,
aveccof
,
bveccof
,
cveccof
,
a21
)
END
IF
IF
(
input
%
l_useapw
)
THEN
! -> B4 force
...
...
@@ -212,10 +219,10 @@ CONTAINS
we
(
ie
)/
atoms
%
neq
(
n
)
*
atoms
%
rmt
(
n
)
**
2
*
AIMAG
(&
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
us
(
l1
,
n
,
jsp
)&
+
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
uds
(
l1
,
n
,
jsp
))
*
&
(
force
%
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
dus
(
l1
,
n
,
jsp
)&
+
force
%
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
duds
(
l1
,
n
,
jsp
)
)&
-
CONJG
(
force
%
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
us
(
l1
,
n
,
jsp
)&
+
force
%
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
uds
(
l1
,
n
,
jsp
)
)
*
&
(
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
dus
(
l1
,
n
,
jsp
)&
+
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
duds
(
l1
,
n
,
jsp
)
)&
-
CONJG
(
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
us
(
l1
,
n
,
jsp
)&
+
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
uds
(
l1
,
n
,
jsp
)
)
*
&
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
dus
(
l1
,
n
,
jsp
)&
+
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
duds
(
l1
,
n
,
jsp
))
)
END
DO
...
...
@@ -232,15 +239,15 @@ CONTAINS
we
(
ie
)/
atoms
%
neq
(
n
)
*
atoms
%
rmt
(
n
)
**
2
*
AIMAG
(&
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
us
(
l1
,
n
,
jsp
)&
+
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
uds
(
l1
,
n
,
jsp
)
)
*
&
force
%
cveccof
(
i
,
m
,
ie
,
lo
,
natrun
)
*
usdus
%
dulos
(
lo
,
n
,
jsp
)&
cveccof
(
i
,
m
,
ie
,
lo
,
natrun
)
*
usdus
%
dulos
(
lo
,
n
,
jsp
)&
+
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
natrun
,
jsp
)
*
usdus
%
ulos
(
lo
,
n
,
jsp
))
*
&
(
force
%
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
dus
(
l1
,
n
,
jsp
)&
+
force
%
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
duds
(
l1
,
n
,
jsp
)&
+
force
%
cveccof
(
i
,
m
,
ie
,
lo
,
natrun
)
*
usdus
%
dulos
(
lo
,
n
,
jsp
)
)
&
-
(
CONJG
(
force
%
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
us
(
l1
,
n
,
jsp
)&
+
force
%
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
uds
(
l1
,
n
,
jsp
)
)
*
&
(
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
dus
(
l1
,
n
,
jsp
)&
+
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
duds
(
l1
,
n
,
jsp
)&
+
cveccof
(
i
,
m
,
ie
,
lo
,
natrun
)
*
usdus
%
dulos
(
lo
,
n
,
jsp
)
)
&
-
(
CONJG
(
aveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
us
(
l1
,
n
,
jsp
)&
+
bveccof
(
i
,
ie
,
lm1
,
natrun
)
*
usdus
%
uds
(
l1
,
n
,
jsp
)
)
*
&
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
natrun
,
jsp
)
*
usdus
%
dulos
(
lo
,
n
,
jsp
)&
+
CONJG
(
force
%
cveccof
(
i
,
m
,
ie
,
lo
,
natrun
)
*
usdus
%
ulos
(
lo
,
n
,
jsp
))
*
&
+
CONJG
(
cveccof
(
i
,
m
,
ie
,
lo
,
natrun
)
*
usdus
%
ulos
(
lo
,
n
,
jsp
))
*
&
(
eigVecCoeffs
%
acof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
dus
(
l1
,
n
,
jsp
)&
+
eigVecCoeffs
%
bcof
(
ie
,
lm1
,
natrun
,
jsp
)
*
usdus
%
duds
(
l1
,
n
,
jsp
)&
+
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
natrun
,
jsp
)
*
usdus
%
dulos
(
lo
,
n
,
jsp
)
)
)
)
...
...
@@ -347,8 +354,8 @@ CONTAINS
! IS ALSO A SOLUTION OF SCHR. EQU. IF PSI IS ONE.
DO
i
=
1
,
3
results
%
force
(
i
,
n
,
jsp
)
=
results
%
force
(
i
,
n
,
jsp
)
+
REAL
(
forc_a21
(
i
)
+
forc_b4
(
i
))
f
orce
%
f_a21
(
i
,
n
)
=
force
%
f_a21
(
i
,
n
)
+
forc_a21
(
i
)
f
orce
%
f_b4
(
i
,
n
)
=
force
%
f_b4
(
i
,
n
)
+
forc_b4
(
i
)
f
_a21
(
i
,
n
)
=
f_a21
(
i
,
n
)
+
forc_a21
(
i
)
f
_b4
(
i
,
n
)
=
f_b4
(
i
,
n
)
+
forc_b4
(
i
)
END
DO
!
! write result moved to force_a8
...
...
force/force_a21_U.f90
View file @
d970cdc8
MODULE
m_forcea21U
CONTAINS
SUBROUTINE
force_a21_U
(
nobd
,
atoms
,
i_u
,
itype
,
isp
,
we
,
ne
,
usdus
,
v_mmp
,
eigVecCoeffs
,
force
,
a21
)
SUBROUTINE
force_a21_U
(
atoms
,
i_u
,
itype
,
isp
,
we
,
ne
,
usdus
,
v_mmp
,
eigVecCoeffs
,
aveccof
,
bveccof
,
cveccof
,
a21
)
!
!***********************************************************************
! This subroutine calculates the lda+U contribution to the HF forces,
...
...
@@ -9,24 +9,27 @@ CONTAINS
!***********************************************************************
!
USE
m_constants
USE
m_types
USE
m_types_setup
USE
m_types_usdus
USE
m_types_cdnval
IMPLICIT
NONE
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_eigVecCoeffs
),
INTENT
(
IN
)
::
eigVecCoeffs
TYPE
(
t_force
),
INTENT
(
IN
)
::
force
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
nobd
INTEGER
,
INTENT
(
IN
)
::
itype
,
isp
,
ne
INTEGER
,
INTENT
(
INOUT
)
::
i_u
! on input: index for the first U for atom type "itype or higher"
! on exit: index for the first U for atom type "itype+1 or higher"
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
we
(
nobd
)
COMPLEX
,
INTENT
(
IN
)
::
v_mmp
(
-
lmaxU_const
:
lmaxU_const
,
-
lmaxU_const
:
lmaxU_const
,
atoms
%
n_u
)
REAL
,
INTENT
(
INOUT
)
::
a21
(
3
,
atoms
%
nat
)
REAL
,
INTENT
(
IN
)
::
we
(
ne
)
COMPLEX
,
INTENT
(
IN
)
::
v_mmp
(
-
lmaxU_const
:
lmaxU_const
,
-
lmaxU_const
:
lmaxU_const
,
atoms
%
n_u
)
COMPLEX
,
INTENT
(
IN
)
::
aveccof
(
3
,
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
bveccof
(
3
,
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
cveccof
(
3
,
-
atoms
%
llod
:
atoms
%
llod
,
ne
,
atoms
%
nlod
,
atoms
%
nat
)
REAL
,
INTENT
(
INOUT
)
::
a21
(
3
,
atoms
%
nat
)
! ..
! .. Local Scalars ..
COMPLEX
v_a
,
v_b
,
v_c
,
p1
,
p2
,
p3
...
...
@@ -59,8 +62,8 @@ CONTAINS
DO
iatom
=
sum
(
atoms
%
neq
(:
itype
-1
))
+1
,
sum
(
atoms
%
neq
(:
itype
))
DO
ie
=
1
,
ne
DO
i
=
1
,
3
p1
=
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm
,
iatom
,
isp
))
*
v_a
)
*
force
%
aveccof
(
i
,
ie
,
lmp
,
iatom
)
p2
=
(
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm
,
iatom
,
isp
))
*
v_b
)
*
force
%
bveccof
(
i
,
ie
,
lmp
,
iatom
)
p1
=
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm
,
iatom
,
isp
))
*
v_a
)
*
aveccof
(
i
,
ie
,
lmp
,
iatom
)
p2
=
(
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm
,
iatom
,
isp
))
*
v_b
)
*
bveccof
(
i
,
ie
,
lmp
,
iatom
)
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+
2.0
*
AIMAG
(
p1
+
p2
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
END
DO
END
DO
...
...
@@ -84,11 +87,11 @@ CONTAINS
DO
iatom
=
sum
(
atoms
%
neq
(:
itype
-1
))
+1
,
sum
(
atoms
%
neq
(:
itype
))
DO
ie
=
1
,
ne
DO
i
=
1
,
3
p1
=
v_a
*
(
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
force
%
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
))
p2
=
v_b
*
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm
,
iatom
,
isp
))
*
force
%
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
force
%
aveccof
(
i
,
ie
,
lmp
,
iatom
))
p3
=
v_c
*
(
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm
,
iatom
,
isp
))
*
force
%
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
force
%
bveccof
(
i
,
ie
,
lmp
,
iatom
))
p1
=
v_a
*
(
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
))
p2
=
v_b
*
(
CONJG
(
eigVecCoeffs
%
acof
(
ie
,
lm
,
iatom
,
isp
))
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
aveccof
(
i
,
ie
,
lmp
,
iatom
))
p3
=
v_c
*
(
CONJG
(
eigVecCoeffs
%
bcof
(
ie
,
lm
,
iatom
,
isp
))
*
cveccof
(
i
,
mp
,
ie
,
lo
,
iatom
)
+
&
CONJG
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
bveccof
(
i
,
ie
,
lmp
,
iatom
))
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+
2.0
*
AIMAG
(
p1
+
p2
+
p3
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
END
DO
END
DO
...
...
force/force_a21_lo.f90
View file @
d970cdc8
...
...
@@ -6,7 +6,8 @@
MODULE
m_forcea21lo
CONTAINS
SUBROUTINE
force_a21_lo
(
nobd
,
atoms
,
isp
,
itype
,
we
,
eig
,
ne
,
eigVecCoeffs
,
force
,
tlmplm
,
usdus
,
a21
)
SUBROUTINE
force_a21_lo
(
atoms
,
isp
,
itype
,
we
,
eig
,
ne
,
eigVecCoeffs
,&
aveccof
,
bveccof
,
cveccof
,
tlmplm
,
usdus
,
a21
)
!
!***********************************************************************
! This subroutine calculates the local orbital contribution to A21,
...
...
@@ -15,21 +16,25 @@ CONTAINS
! p.kurz nov. 1997
!***********************************************************************
!
USE
m_types
USE
m_types_setup
USE
m_types_usdus
USE
m_types_tlmplm
USE
m_types_cdnval
IMPLICIT
NONE
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
TYPE
(
t_tlmplm
),
INTENT
(
IN
)
::
tlmplm
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_eigVecCoeffs
),
INTENT
(
IN
)
::
eigVecCoeffs
TYPE
(
t_force
),
INTENT
(
IN
)
::
force
! ..
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
nobd
INTEGER
,
INTENT
(
IN
)
::
itype
,
ne
,
isp
! ..
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
we
(
nobd
),
eig
(:)
!(dimension%neigd)
REAL
,
INTENT
(
INOUT
)
::
a21
(
3
,
atoms
%
nat
)
REAL
,
INTENT
(
IN
)
::
we
(
ne
),
eig
(:)
!(dimension%neigd)
REAL
,
INTENT
(
INOUT
)
::
a21
(
3
,
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
aveccof
(
3
,
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
bveccof
(
3
,
ne
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
)
COMPLEX
,
INTENT
(
IN
)
::
cveccof
(
3
,
-
atoms
%
llod
:
atoms
%
llod
,
ne
,
atoms
%
nlod
,
atoms
%
nat
)
! ..
! .. Local Scalars ..
COMPLEX
utulo
,
dtulo
,
cutulo
,
cdtulo
,
ulotulo
...
...
@@ -68,13 +73,13 @@ CONTAINS
DO
i
=
1
,
3
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+2.0
*
aimag
(&
conjg
(
eigVecCoeffs
%
acof
(
ie
,
lmp
,
iatom
,
isp
))
*
utulo
&
*
force
%
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)&
*
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)&
+
conjg
(
eigVecCoeffs
%
bcof
(
ie
,
lmp
,
iatom
,
isp
))
*
dtulo
&
*
force
%
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)&
*
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)&
+
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))&
*
cutulo
*
force
%
aveccof
(
i
,
ie
,
lmp
,
iatom
)&
*
cutulo
*
aveccof
(
i
,
ie
,
lmp
,
iatom
)&
+
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))&
*
cdtulo
*
force
%
bveccof
(
i
,
ie
,
lmp
,
iatom
)&
*
cdtulo
*
bveccof
(
i
,
ie
,
lmp
,
iatom
)&
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
ENDDO
ENDDO
...
...
@@ -102,7 +107,7 @@ CONTAINS
DO
i
=
1
,
3
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
+2.0
*
aimag
(&
+
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))&
*
ulotulo
*
force
%
cveccof
(
i
,
mp
,
ie
,
lop
,
iatom
)&
*
ulotulo
*
cveccof
(
i
,
mp
,
ie
,
lop
,
iatom
)&
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
ENDDO
ENDDO
...
...
@@ -115,10 +120,10 @@ CONTAINS
DO
i
=
1
,
3
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)&
-2.0
*
aimag
(&
(
conjg
(
eigVecCoeffs
%
acof
(
ie
,
lm
,
iatom
,
isp
))
*
force
%
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)
+
&
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
force
%
aveccof
(
i
,
ie
,
lm
,
iatom
))
*
usdus
%
uulon
(
lo
,
itype
,
isp
)
+
&
(
conjg
(
eigVecCoeffs
%
bcof
(
ie
,
lm
,
iatom
,
isp
))
*
force
%
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)
+
&
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
force
%
bveccof
(
i
,
ie
,
lm
,
iatom
))
*
&
(
conjg
(
eigVecCoeffs
%
acof
(
ie
,
lm
,
iatom
,
isp
))
*
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)
+
&
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
aveccof
(
i
,
ie
,
lm
,
iatom
))
*
usdus
%
uulon
(
lo
,
itype
,
isp
)
+
&
(
conjg
(
eigVecCoeffs
%
bcof
(
ie
,
lm
,
iatom
,
isp
))
*
cveccof
(
i
,
m
,
ie
,
lo
,
iatom
)
+
&
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
bveccof
(
i
,
ie
,
lm
,
iatom
))
*
&
usdus
%
dulon
(
lo
,
itype
,
isp
))
*
eig
(
ie
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
ENDDO
ENDDO
...
...
@@ -130,7 +135,7 @@ CONTAINS
DO
i
=
1
,
3
a21
(
i
,
iatom
)
=
a21
(
i
,
iatom
)
-2.0
*
aimag
(&
conjg
(
eigVecCoeffs
%
ccof
(
m
,
ie
,
lo
,
iatom
,
isp
))
*
&
force
%
cveccof
(
i
,
m
,
ie
,
lop
,
iatom
)
*
&
cveccof
(
i
,
m
,
ie
,
lop
,
iatom
)
*
&
usdus
%
uloulopn
(
lo
,
lop
,
itype
,
isp
))
*
&
eig
(
ie
)
*
we
(
ie
)/
atoms
%
neq
(
itype
)
...
...
types/CMakeLists.txt
View file @
d970cdc8
...
...
@@ -19,6 +19,7 @@ types/types_cdnval.f90
types/types_field.F90
types/types_regionCharges.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
set
(
inpgen_F90
${
inpgen_F90
}
...
...
@@ -40,4 +41,5 @@ types/types_usdus.F90
types/types_cdnval.f90
types/types_regionCharges.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
types/types.F90
View file @
d970cdc8
...
...
@@ -23,5 +23,6 @@ MODULE m_types
USE
m_types_field
USE
m_types_regionCharges
USE
m_types_denCoeffsOffdiag
USE
m_types_force
END
MODULE
m_types
types/types_cdnval.f90
View file @
d970cdc8
...
...
@@ -60,26 +60,6 @@ PRIVATE
PROCEDURE
,
PASS
::
init
=>
denCoeffs_init
END
TYPE
t_denCoeffs
TYPE
t_force
COMPLEX
,
ALLOCATABLE
::
f_a12
(:,:)
COMPLEX
,
ALLOCATABLE
::
f_a21
(:,:)
COMPLEX
,
ALLOCATABLE
::
f_b4
(:,:)
COMPLEX
,
ALLOCATABLE
::
f_b8
(:,:)
COMPLEX
,
ALLOCATABLE
::
e1cof
(:,:,:)
COMPLEX
,
ALLOCATABLE
::
e2cof
(:,:,:)
COMPLEX
,
ALLOCATABLE
::
aveccof
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
bveccof
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
cveccof
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
acoflo
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
bcoflo
(:,:,:,:)
CONTAINS
PROCEDURE
,
PASS
::
init1
=>
force_init1
PROCEDURE
,
PASS
::
init2
=>
force_init2
END
TYPE
t_force
TYPE
t_slab
INTEGER
::
nsld
,
nsl
...
...
@@ -162,7 +142,7 @@ PRIVATE
PROCEDURE
,
PASS
::
init
=>
gVacMap_init
END
TYPE
t_gVacMap
PUBLIC
t_orb
,
t_denCoeffs
,
t_
force
,
t_
slab
,
t_eigVecCoeffs
PUBLIC
t_orb
,
t_denCoeffs
,
t_slab
,
t_eigVecCoeffs
PUBLIC
t_mcd
,
t_moments
,
t_orbcomp
,
t_cdnvalKLoop
,
t_gVacMap
CONTAINS
...
...
@@ -298,82 +278,6 @@ SUBROUTINE denCoeffs_init(thisDenCoeffs, atoms, sphhar, jsp_start, jsp_end)
END
SUBROUTINE
denCoeffs_init
SUBROUTINE
force_init1
(
thisForce
,
input
,
atoms
)
USE
m_types_setup
IMPLICIT
NONE
CLASS
(
t_force
),
INTENT
(
INOUT
)
::
thisForce
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
IF
(
input
%
l_f
)
THEN
ALLOCATE
(
thisForce
%
f_a12
(
3
,
atoms
%
ntype
))
ALLOCATE
(
thisForce
%
f_a21
(
3
,
atoms
%
ntype
))
ALLOCATE
(
thisForce
%
f_b4
(
3
,
atoms
%
ntype
))
ALLOCATE
(
thisForce
%
f_b8
(
3
,
atoms
%
ntype
))
ELSE
ALLOCATE
(
thisForce
%
f_a12
(
1
,
1
))
ALLOCATE
(
thisForce
%
f_a21
(
1
,
1
))
ALLOCATE
(
thisForce
%
f_b4
(
1
,
1
))
ALLOCATE
(
thisForce
%
f_b8
(
1
,
1
))
END
IF
thisForce
%
f_a12
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
f_a21
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
f_b4
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
f_b8
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
force_init1
SUBROUTINE
force_init2
(
thisForce
,
noccbd
,
input
,
atoms
)
USE
m_types_setup
IMPLICIT
NONE
CLASS
(
t_force
),
INTENT
(
INOUT
)
::
thisForce
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
INTEGER
,
INTENT
(
IN
)
::
noccbd
IF
(
ALLOCATED
(
thisForce
%
e1cof
))
DEALLOCATE
(
thisForce
%
e1cof
)
IF
(
ALLOCATED
(
thisForce
%
e2cof
))
DEALLOCATE
(
thisForce
%
e2cof
)
IF
(
ALLOCATED
(
thisForce
%
acoflo
))
DEALLOCATE
(
thisForce
%
acoflo
)
IF
(
ALLOCATED
(
thisForce
%
bcoflo
))
DEALLOCATE
(
thisForce
%
bcoflo
)
IF
(
ALLOCATED
(
thisForce
%
aveccof
))
DEALLOCATE
(
thisForce
%
aveccof
)
IF
(
ALLOCATED
(
thisForce
%
bveccof
))
DEALLOCATE
(
thisForce
%
bveccof
)
IF
(
ALLOCATED
(
thisForce
%
cveccof
))
DEALLOCATE
(
thisForce
%
cveccof
)
IF
(
input
%
l_f
)
THEN
ALLOCATE
(
thisForce
%
e1cof
(
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
e2cof
(
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
acoflo
(
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
nat
))
ALLOCATE
(
thisForce
%
bcoflo
(
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
nat
))
ALLOCATE
(
thisForce
%
aveccof
(
3
,
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
bveccof
(
3
,
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
cveccof
(
3
,
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
nat
))
ELSE
ALLOCATE
(
thisForce
%
e1cof
(
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
e2cof
(
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
acoflo
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
bcoflo
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
aveccof
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
bveccof
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
cveccof
(
1
,
1
,
1
,
1
,
1
))
END
IF
thisForce
%
e1cof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
e2cof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
acoflo
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
bcoflo
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
aveccof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
bveccof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
cveccof
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
force_init2
SUBROUTINE
slab_init
(
thisSlab
,
banddos
,
dimension
,
atoms
,
cell
)
USE
m_types_setup
...
...
types/types_force.f90
0 → 100644
View file @
d970cdc8
!--------------------------------------------------------------------------------
! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE
m_types_force
IMPLICIT
NONE
PRIVATE
TYPE
t_force
COMPLEX
,
ALLOCATABLE
::
f_a12
(:,:)
COMPLEX
,
ALLOCATABLE
::
f_a21
(:,:)
COMPLEX
,
ALLOCATABLE
::
f_b4
(:,:)
COMPLEX
,
ALLOCATABLE
::
f_b8
(:,:)
COMPLEX
,
ALLOCATABLE
::
e1cof
(:,:,:)
COMPLEX
,
ALLOCATABLE
::
e2cof
(:,:,:)
COMPLEX
,
ALLOCATABLE
::
aveccof
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
bveccof
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
cveccof
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
acoflo
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
bcoflo
(:,:,:,:)
CONTAINS
PROCEDURE
,
PASS
::
init1
=>
force_init1
PROCEDURE
,
PASS
::
init2
=>
force_init2
PROCEDURE
::
addContribsA21A12
END
TYPE
t_force
PUBLIC
t_force
CONTAINS
SUBROUTINE
force_init1
(
thisForce
,
input
,
atoms
)
USE
m_types_setup
IMPLICIT
NONE
CLASS
(
t_force
),
INTENT
(
INOUT
)
::
thisForce
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
IF
(
input
%
l_f
)
THEN
ALLOCATE
(
thisForce
%
f_a12
(
3
,
atoms
%
ntype
))
ALLOCATE
(
thisForce
%
f_a21
(
3
,
atoms
%
ntype
))
ALLOCATE
(
thisForce
%
f_b4
(
3
,
atoms
%
ntype
))
ALLOCATE
(
thisForce
%
f_b8
(
3
,
atoms
%
ntype
))
ELSE
ALLOCATE
(
thisForce
%
f_a12
(
1
,
1
))
ALLOCATE
(
thisForce
%
f_a21
(
1
,
1
))
ALLOCATE
(
thisForce
%
f_b4
(
1
,
1
))
ALLOCATE
(
thisForce
%
f_b8
(
1
,
1
))
END
IF
thisForce
%
f_a12
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
f_a21
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
f_b4
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
f_b8
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
force_init1
SUBROUTINE
force_init2
(
thisForce
,
noccbd
,
input
,
atoms
)
USE
m_types_setup
IMPLICIT
NONE
CLASS
(
t_force
),
INTENT
(
INOUT
)
::
thisForce
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
INTEGER
,
INTENT
(
IN
)
::
noccbd
IF
(
ALLOCATED
(
thisForce
%
e1cof
))
DEALLOCATE
(
thisForce
%
e1cof
)
IF
(
ALLOCATED
(
thisForce
%
e2cof
))
DEALLOCATE
(
thisForce
%
e2cof
)
IF
(
ALLOCATED
(
thisForce
%
acoflo
))
DEALLOCATE
(
thisForce
%
acoflo
)
IF
(
ALLOCATED
(
thisForce
%
bcoflo
))
DEALLOCATE
(
thisForce
%
bcoflo
)
IF
(
ALLOCATED
(
thisForce
%
aveccof
))
DEALLOCATE
(
thisForce
%
aveccof
)
IF
(
ALLOCATED
(
thisForce
%
bveccof
))
DEALLOCATE
(
thisForce
%
bveccof
)
IF
(
ALLOCATED
(
thisForce
%
cveccof
))
DEALLOCATE
(
thisForce
%
cveccof
)
IF
(
input
%
l_f
)
THEN
ALLOCATE
(
thisForce
%
e1cof
(
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
e2cof
(
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
acoflo
(
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
nat
))
ALLOCATE
(
thisForce
%
bcoflo
(
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
nat
))
ALLOCATE
(
thisForce
%
aveccof
(
3
,
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
bveccof
(
3
,
noccbd
,
0
:
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+2
),
atoms
%
nat
))
ALLOCATE
(
thisForce
%
cveccof
(
3
,
-
atoms
%
llod
:
atoms
%
llod
,
noccbd
,
atoms
%
nlod
,
atoms
%
nat
))
ELSE
ALLOCATE
(
thisForce
%
e1cof
(
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
e2cof
(
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
acoflo
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
bcoflo
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
aveccof
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
bveccof
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisForce
%
cveccof
(
1
,
1
,
1
,
1
,
1
))
END
IF
thisForce
%
e1cof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
e2cof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
acoflo
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
bcoflo
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
aveccof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
bveccof
=
CMPLX
(
0.0
,
0.0
)
thisForce
%
cveccof
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
force_init2
SUBROUTINE
addContribsA21A12
(
thisForce
,
input
,
atoms
,
dimension
,
sym
,
cell
,
oneD
,
enpara
,&
usdus
,
eigVecCoeffs
,
noccbd
,
ispin
,
eig
,
we
,
results
)
USE
m_types_setup
USE
m_types_usdus
USE
m_types_enpara
USE
m_types_cdnval
USE
m_types_misc
USE
m_forcea12
USE
m_forcea21
IMPLICIT
NONE
CLASS
(
t_force
),
INTENT
(
INOUT
)
::
thisForce