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
52
Issues
52
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
ed8a3553
Commit
ed8a3553
authored
Sep 13, 2018
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop
parents
969f97e4
0d31f0ab
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
84 additions
and
51 deletions
+84
-51
cdn/cdntot.f90
cdn/cdntot.f90
+22
-33
diagonalization/chase_diag.F90
diagonalization/chase_diag.F90
+54
-14
external/chase/src/FLEUR/fleur_chase.cpp
external/chase/src/FLEUR/fleur_chase.cpp
+6
-4
main/fleur.F90
main/fleur.F90
+2
-0
No files found.
cdn/cdntot.f90
View file @
ed8a3553
MODULE
m_cdntot
MODULE
m_cdntot
! ********************************************************
! calculate the total charge density in the interstial.,
! vacuum, and mt regions c.l.fu
! ********************************************************
CONTAINS
SUBROUTINE
cdntot
(
stars
,
atoms
,
sym
,
vacuum
,
input
,
cell
,
oneD
,&
den
,
l_printData
,
qtot
,
qistot
)
CONTAINS
SUBROUTINE
cdntot
(
stars
,
atoms
,
sym
,
vacuum
,
input
,
cell
,
oneD
,&
den
,
l_printData
,
qtot
,
qistot
)
USE
m_intgr
,
ONLY
:
intgr3
USE
m_constants
...
...
@@ -55,19 +55,19 @@
q
=
0.e0
! -----mt charge
CALL
timestart
(
"MT"
)
DO
10
n
=
1
,
atoms
%
ntype
DO
n
=
1
,
atoms
%
ntype
CALL
intgr3
(
den
%
mt
(:,
0
,
n
,
jspin
),
atoms
%
rmsh
(:,
n
),
atoms
%
dx
(
n
),
atoms
%
jri
(
n
),
w
)
qmt
(
n
)
=
w
*
sfp_const
q
=
q
+
atoms
%
neq
(
n
)
*
qmt
(
n
)
10
CONTINUE
ENDDO
CALL
timestop
(
"MT"
)
! -----vacuum region
IF
(
input
%
film
)
THEN
DO
20
ivac
=
1
,
vacuum
%
nvac
DO
ivac
=
1
,
vacuum
%
nvac
DO
nz
=
1
,
vacuum
%
nmz
IF
(
oneD
%
odi
%
d1
)
THEN
rht1
(
nz
,
ivac
,
jspin
)
=
(
cell
%
z1
+
(
nz
-1
)
*
vacuum
%
delz
)
*
&
&
den
%
vacz
(
nz
,
ivac
,
jspin
)
den
%
vacz
(
nz
,
ivac
,
jspin
)
ELSE
rht1
(
nz
,
ivac
,
jspin
)
=
den
%
vacz
(
nz
,
ivac
,
jspin
)
END
IF
...
...
@@ -79,30 +79,19 @@
ELSE
q
=
q
+
cell
%
area
*
q2
(
1
)
END
IF
20
CONTINUE
ENDDO
END
IF
! -----is region
IF
(
.not.
judft_was_Argument
(
"-oldfix"
))
THEN
CALL
convol
(
stars
,
x
,
den
%
pw
(:,
jspin
),
stars
%
ufft
)
qis
=
x
(
1
)
*
cell
%
omtil
ELSE
qis
=
0.
! DO 30 j = 1,nq3
! CALL pwint(
! > k1d,k2d,k3d,n3d,ntypd,natd,nop,invtab,odi,
! > ntype,neq,volmts,taual,z1,vol,volint,
! > symor,tau,mrot,rmt,sk3,bmat,ig2,ig,
! > kv3(1,j),
! < x)
! qis = qis + den%pw(j,jspin)*x*nstr(j)
! 30 CONTINUE
CALL
pwint_all
(&
&
stars
,
atoms
,
sym
,
oneD
,&
&
cell
,&
&
x
)
DO
j
=
1
,
stars
%
ng3
qis
=
qis
+
den
%
pw
(
j
,
jspin
)
*
x
(
j
)
*
stars
%
nstr
(
j
)
ENDDO
qis
=
0.
CALL
pwint_all
(
stars
,
atoms
,
sym
,
oneD
,
cell
,
x
)
DO
j
=
1
,
stars
%
ng3
qis
=
qis
+
den
%
pw
(
j
,
jspin
)
*
x
(
j
)
*
stars
%
nstr
(
j
)
ENDDO
endif
qistot
=
qistot
+
qis
q
=
q
+
qis
...
...
@@ -137,12 +126,12 @@
IF
(
l_printData
)
THEN
CALL
writeXMLElementFormPoly
(
'totalCharge'
,(/
'value'
/),(/
qtot
/),
reshape
((/
5
,
20
/),(/
1
,
2
/)))
END
IF
8000
FORMAT
(
/
,
10x
,
'total charge for spin'
,
i3
,
'='
,
f12.6
,
/
,
10x
,
&
&
'interst. charge = '
,
f12.6
,
/
,
&
&
(
10x
,
'mt charge= '
,
4f12.6
,
/
))
8010
FORMAT
(
10x
,
'vacuum '
,
i2
,
' charge= '
,
f12.6
)
8020
FORMAT
(
/
,
10x
,
'total charge ='
,
f12.6
)
8000
FORMAT
(
/
,
10x
,
'total charge for spin'
,
i3
,
'='
,
f12.6
,
/
,
10x
,
&
'interst. charge = '
,
f12.6
,
/
,
&
(
10x
,
'mt charge= '
,
4f12.6
,
/
))
8010
FORMAT
(
10x
,
'vacuum '
,
i2
,
' charge= '
,
f12.6
)
8020
FORMAT
(
/
,
10x
,
'total charge ='
,
f12.6
)
CALL
timestop
(
"cdntot"
)
END
SUBROUTINE
cdntot
END
MODULE
m_cdntot
END
SUBROUTINE
cdntot
END
MODULE
m_cdntot
diagonalization/chase_diag.F90
View file @
ed8a3553
...
...
@@ -70,13 +70,25 @@ IMPLICIT NONE
PRIVATE
INTEGER
::
chase_eig_id
INTEGER
::
chase_eig_id
PUBLIC
init_chase
,
chase_diag
#endif
REAL
::
scale_distance
REAL
::
tol
PUBLIC
chase_distance
CONTAINS
CONTAINS
SUBROUTINE
init_chase
(
mpi
,
dimension
,
atoms
,
kpts
,
noco
,
l_real
)
SUBROUTINE
chase_distance
(
dist
)
IMPLICIT
NONE
REAL
,
INTENT
(
in
)::
dist
tol
=
MAX
(
1E-8
,
dist
*
scale_distance
)
END
SUBROUTINE
chase_distance
#ifdef CPP_CHASE
SUBROUTINE
init_chase
(
mpi
,
DIMENSION
,
atoms
,
kpts
,
noco
,
l_real
)
USE
m_types_mpimat
USE
m_types
USE
m_types_mpi
...
...
@@ -90,11 +102,18 @@ IMPLICIT NONE
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
LOGICAL
,
INTENT
(
IN
)
::
l_real
INTEGER
::
nevd
,
nexd
CHARACTER
(
len
=
1000
)::
arg
scale_distance
=
1E-3
IF
(
judft_was_argument
(
"-chase_scale"
))
THEN
arg
=
juDFT_string_for_argument
(
"-chase_scale"
)
READ
(
arg
,
*
)
scale_distance
ENDIF
IF
(
juDFT_was_argument
(
"-diag:chase"
))
THEN
nevd
=
min
(
dimension
%
neigd
,
dimension
%
nvd
+
atoms
%
nlotot
)
nexd
=
min
(
max
(
nevd
/
4
,
45
),
dimension
%
nvd
+
atoms
%
nlotot
-
nevd
)
!dimensioning for workspace
...
...
@@ -204,10 +223,10 @@ IMPLICIT NONE
end
do
end
do
if
(
iter
.EQ.
1
)
then
call
chase_r
(
hmat
%
data_r
,
hmat
%
matsize1
,
zMatTemp
%
data_r
,
eigenvalues
,
nev
,
nex
,
25
,
1e-6
,
'R'
,
'S'
)
CALL
chase_r
(
hmat
%
data_r
,
hmat
%
matsize1
,
zMatTemp
%
data_r
,
eigenvalues
,
nev
,
nex
,
25
,
scale_distance
,
'R'
,
'S'
)
else
CALL
read_eig
(
chase_eig_id
,
ikpt
,
jsp
,
neig
=
nbands
,
eig
=
eigenvalues
,
zmat
=
zMatTemp
)
call
chase_r
(
hmat
%
data_r
,
hmat
%
matsize1
,
zMatTemp
%
data_r
,
eigenvalues
,
nev
,
nex
,
25
,
1e-6
,
'A'
,
'S'
)
CALL
chase_r
(
hmat
%
data_r
,
hmat
%
matsize1
,
zMatTemp
%
data_r
,
eigenvalues
,
nev
,
nex
,
25
,
tol
,
'A'
,
'S'
)
end
if
ne
=
nev
...
...
@@ -259,10 +278,10 @@ IMPLICIT NONE
end
do
if
(
iter
.EQ.
1
)
then
call
chase_c
(
hmat
%
data_c
,
hmat
%
matsize1
,
zMatTemp
%
data_c
,
eigenvalues
,
nev
,
nex
,
25
,
1e-6
,
'R'
,
'S'
)
CALL
chase_c
(
hmat
%
data_c
,
hmat
%
matsize1
,
zMatTemp
%
data_c
,
eigenvalues
,
nev
,
nex
,
25
,
scale_distance
,
'R'
,
'S'
)
else
CALL
read_eig
(
chase_eig_id
,
ikpt
,
jsp
,
neig
=
nbands
,
eig
=
eigenvalues
,
zmat
=
zMatTemp
)
call
chase_c
(
hmat
%
data_c
,
hmat
%
matsize1
,
zMatTemp
%
data_c
,
eigenvalues
,
nev
,
nex
,
25
,
1e-6
,
'A'
,
'S'
)
call
chase_c
(
hmat
%
data_c
,
hmat
%
matsize1
,
zMatTemp
%
data_c
,
eigenvalues
,
nev
,
nex
,
25
,
tol
,
'A'
,
'S'
)
end
if
ne
=
nev
...
...
@@ -313,8 +332,11 @@ IMPLICIT NONE
TYPE
(
t_mat
)
::
zMatTemp
TYPE
(
t_mpimat
)
::
chase_mat
REAL
,
ALLOCATABLE
::
eigenvalues
(:)
REAL
::
t1
,
t2
,
t3
,
t4
include
'mpif.h'
CALL
CPU_TIME
(
t1
)
CALL
MPI_COMM_RANK
(
hmat
%
mpi_com
,
myid
,
info
)
CALL
MPI_COMM_SIZE
(
hmat
%
mpi_com
,
np
,
info
)
smat
%
blacs_desc
=
hmat
%
blacs_desc
...
...
@@ -361,17 +383,25 @@ IMPLICIT NONE
IF
(
hmat
%
l_real
)
THEN
IF
(
iter
.EQ.
1
)
THEN
CALL
mpi_chase_r
(
chase_mat
%
data_r
,
zMatTemp
%
data_r
,
eigenvalues
,
25
,
1e-10
,
'R'
,
'S'
)
CALL
CPU_TIME
(
t2
)
CALL
mpi_chase_r
(
chase_mat
%
data_r
,
zMatTemp
%
data_r
,
eigenvalues
,
25
,
1E-4
,
'R'
,
'S'
)
CALL
CPU_TIME
(
t3
)
ELSE
CALL
read_eig
(
chase_eig_id
,
ikpt
,
jsp
,
neig
=
nbands
,
eig
=
eigenvalues
,
zmat
=
zMatTemp
)
CALL
mpi_chase_r
(
chase_mat
%
data_r
,
zMatTemp
%
data_r
,
eigenvalues
,
25
,
1e-10
,
'A'
,
'S'
)
CALL
CPU_TIME
(
t2
)
CALL
mpi_chase_r
(
chase_mat
%
data_r
,
zMatTemp
%
data_r
,
eigenvalues
,
25
,
tol
,
'A'
,
'S'
)
CALL
CPU_TIME
(
t3
)
END
IF
ELSE
IF
(
iter
.EQ.
1
)
THEN
CALL
mpi_chase_c
(
chase_mat
%
data_c
,
zMatTemp
%
data_c
,
eigenvalues
,
25
,
1e-10
,
'R'
,
'S'
)
CALL
CPU_TIME
(
t2
)
CALL
mpi_chase_c
(
chase_mat
%
data_c
,
zMatTemp
%
data_c
,
eigenvalues
,
25
,
1E-4
,
'R'
,
'S'
)
CALL
CPU_TIME
(
t3
)
ELSE
CALL
read_eig
(
chase_eig_id
,
ikpt
,
jsp
,
neig
=
nbands
,
eig
=
eigenvalues
,
zmat
=
zMatTemp
)
CALL
mpi_chase_c
(
chase_mat
%
data_c
,
zMatTemp
%
data_c
,
eigenvalues
,
25
,
1e-10
,
'A'
,
'S'
)
CALL
CPU_TIME
(
t2
)
CALL
mpi_chase_c
(
chase_mat
%
data_c
,
zMatTemp
%
data_c
,
eigenvalues
,
25
,
tol
,
'A'
,
'S'
)
CALL
CPU_TIME
(
t3
)
END
IF
ENDIF
...
...
@@ -408,6 +438,16 @@ IMPLICIT NONE
ne
=
ne
+1
eig
(
ne
)
=
eigenvalues
(
i
)
ENDDO
CALL
CPU_TIME
(
t4
)
IF
(
myid
==
0
)
THEN
PRINT
*
,
"Chase Prep:"
,
t2
-
t1
PRINT
*
,
"Chase Call:"
,
t3
-
t2
PRINT
*
,
"Chase Post:"
,
t4
-
t3
PRINT
*
,
"Chase Total:"
,
t4
-
t1
ENDIF
END
SUBROUTINE
chase_diag_MPI
SUBROUTINE
priv_init_chasempimat
(
hmat
,
mat
,
nev
,
nex
)
...
...
external/chase/src/FLEUR/fleur_chase.cpp
View file @
ed8a3553
...
...
@@ -127,10 +127,6 @@ void chase_solve(T* H, T* V, Base<T>* ritzv, int* deg, double* tol, char* mode,
auto
nev
=
config
.
GetNev
();
auto
nex
=
config
.
GetNex
();
if
(
!
config
.
UseApprox
())
for
(
std
::
size_t
k
=
0
;
k
<
N
*
(
nev
+
nex
);
++
k
)
V
[
k
]
=
getRandomT
<
T
>
([
&
]()
{
return
d
(
gen
);
});
for
(
std
::
size_t
k
=
0
;
k
<
xlen
*
ylen
;
++
k
)
H_
[
k
]
=
H
[
k
];
config
.
SetTol
(
*
tol
);
...
...
@@ -138,6 +134,12 @@ void chase_solve(T* H, T* V, Base<T>* ritzv, int* deg, double* tol, char* mode,
config
.
SetOpt
(
*
opt
==
'S'
);
config
.
SetApprox
(
*
mode
==
'A'
);
if
(
!
config
.
UseApprox
()){
std
::
cerr
<<
"random vectors"
<<
std
::
endl
;
for
(
std
::
size_t
k
=
0
;
k
<
N
*
(
nev
+
nex
);
++
k
)
V
[
k
]
=
getRandomT
<
T
>
([
&
]()
{
return
d
(
gen
);
});
}
chase
::
Solve
(
&
single
);
}
...
...
main/fleur.F90
View file @
ed8a3553
...
...
@@ -193,6 +193,8 @@ CONTAINS
ENDIF
!mpi%irank.eq.0
input
%
total
=
.TRUE.
CALL
chase_distance
(
results
%
last_distance
)
#ifdef CPP_MPI
CALL
mpi_bc_potden
(
mpi
,
stars
,
sphhar
,
atoms
,
input
,
vacuum
,
oneD
,
noco
,
inDen
)
#endif
...
...
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