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
8af7d700
Commit
8af7d700
authored
Nov 09, 2016
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Bugfixes for parallel version
parent
970b8d82
Changes
5
Show whitespace changes
Inline
Side-by-side
Showing
5 changed files
with
32 additions
and
33 deletions
+32
-33
diagonalization/chani.F90
diagonalization/chani.F90
+22
-26
diagonalization/eigen_diag.F90
diagonalization/eigen_diag.F90
+1
-1
diagonalization/ssubredist1.F90
diagonalization/ssubredist1.F90
+3
-0
eigen/hlomat.F90
eigen/hlomat.F90
+2
-2
io/eig66_mpi.F90
io/eig66_mpi.F90
+4
-4
No files found.
diagonalization/chani.F90
View file @
8af7d700
...
...
@@ -7,7 +7,7 @@
MODULE
m_chani
CONTAINS
SUBROUTINE
chani
(
M
,
N
,
Neigd
,
Myid
,
Np
,
Sub_comm
,
mpi_comm
,
&
Eig
,
Num
,
A_r
,
B_r
,
Z_r
,
A_c
,
B_c
,
Z_c
)
Eig
,
Num
,
hamOvlp
,
zMat
)
!
!----------------------------------------------------
!- Parallel eigensystem solver - driver routine; gb99
...
...
@@ -33,6 +33,8 @@ CONTAINS
!#include"cpp_arch.h"
#include"cpp_double.h"
USE
m_juDFT
USE
m_types
USE
m_subredist1
IMPLICIT
NONE
INCLUDE
'mpif.h'
...
...
@@ -40,10 +42,8 @@ CONTAINS
INTEGER
,
INTENT
(
IN
)
::
SUB_COMM
,
np
,
myid
,
mpi_comm
INTEGER
,
INTENT
(
INOUT
)
::
num
REAL
,
INTENT
(
OUT
)
::
eig
(
neigd
)
REAL
,
OPTIONAL
,
INTENT
(
INOUT
)
::
a_r
(
m
,
n
),
b_r
(
m
,
n
)
REAL
,
OPTIONAL
,
INTENT
(
OUT
)
::
z_r
(
m
,
neigd
)
COMPLEX
,
OPTIONAL
,
INTENT
(
INOUT
)
::
a_c
(
m
,
n
),
b_c
(
m
,
n
)
COMPLEX
,
OPTIONAL
,
INTENT
(
OUT
)
::
z_c
(
m
,
neigd
)
TYPE
(
t_hamOvlp
),
INTENT
(
INOUT
)
::
hamOvlp
TYPE
(
t_zMat
),
INTENT
(
INOUT
)
::
zMat
!... Local variables
!
...
...
@@ -74,13 +74,11 @@ CONTAINS
REAL
,
ALLOCATABLE
::
asca_r
(:,:),
bsca_r
(:,:),
work2_r
(:)
COMPLEX
,
ALLOCATABLE
::
asca_c
(:,:),
bsca_c
(:,:),
work2_c
(:)
EXTERNAL
subredist
1
,
subredist
2
,
iceil
,
numroc
EXTERNAL
subredist2
,
iceil
,
numroc
EXTERNAL
CPP_LAPACK_slamch
,
descinit
EXTERNAL
blacs_pinfo
,
blacs_gridinit
EXTERNAL
MPI_COMM_DUP
LOGICAL
::
l_real
l_real
=
present
(
a_r
)
!
! determine actual number of columns of input matrices A and B
! nc is number of columns the local processor will get, must be <=n
...
...
@@ -132,17 +130,17 @@ CONTAINS
mycolssca
=
(
m
-1
)/(
nb
*
npcol
)
*
nb
+
&
MIN
(
MAX
(
m
-
(
m
-1
)/(
nb
*
npcol
)
*
nb
*
npcol
-
nb
*
mycol
,
0
),
nb
)
! Number of columns the local process gets in ScaLAPACK distribution
if
(
l_real
)
THEN
if
(
hamOvlp
%
l_real
)
THEN
ALLOCATE
(
asca_r
(
myrowssca
,
mycolssca
),
stat
=
err
)
else
ALLOCATE
(
asca_c
(
myrowssca
,
mycolssca
),
stat
=
err
)
end
end
if
IF
(
err
.NE.
0
)
THEN
WRITE
(
*
,
*
)
'In chani an error occured during the allocation of'
WRITE
(
*
,
*
)
'asca: '
,
err
,
' size: '
,
myrowssca
*
mycolssca
CALL
juDFT_error
(
"allocte in chani"
,
calledby
=
"chani"
)
ENDIF
if
(
l_real
)
THEN
if
(
hamOvlp
%
l_real
)
THEN
asca_r
=
0.0
ALLOCATE
(
bsca_r
(
myrowssca
,
mycolssca
),
stat
=
err
)
else
...
...
@@ -154,14 +152,14 @@ CONTAINS
WRITE
(
*
,
*
)
'bsca :'
,
err
CALL
juDFT_error
(
"allocate in chani"
,
calledby
=
"chani"
)
ENDIF
if
(
l_real
)
THEN
if
(
hamOvlp
%
l_real
)
THEN
bsca_r
=
0.0
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
a
_r
,
asca_r
)
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
b_r
,
bsca_r
)
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
a
chi_r
=
hamovlp
%
a_r
,
asca_r
=
asca_r
)
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
achi_r
=
hamovlp
%
b_r
,
asca_r
=
bsca_r
)
else
bsca_c
=
0.0
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
a
_c
,
asca_c
)
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
b_c
,
bsca_c
)
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
a
chi_c
=
hamovlp
%
a_c
,
asca_c
=
asca_c
)
CALL
subredist1
(
m
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
achi_c
=
hamovlp
%
b_c
,
asca_c
=
bsca_c
)
end
if
CALL
BLACS_PINFO
(
iamblacs
,
npblacs
)
! iamblacs = local process rank (e.g. myid)
! npblacs = number of available processes
...
...
@@ -243,7 +241,7 @@ CONTAINS
CALL
juDFT_error
(
'Failed to allocated "eig2"'
,
calledby
=
'chani'
)
ENDIF
! write(*,*) 'c :',myrowssca,mycolssca,desceigv
if
(
l_real
)
THEN
if
(
hamovlp
%
l_real
)
THEN
ALLOCATE
(
eigvec_r
(
myrowssca
,
mycolssca
),
stat
=
err
)
! Eigenvectors for ScaLAPACK
else
ALLOCATE
(
eigvec_c
(
myrowssca
,
mycolssca
),
stat
=
err
)
! Eigenvectors for ScaLAPACK
...
...
@@ -257,7 +255,7 @@ CONTAINS
nn
=
MAX
(
MAX
(
m
,
nb
),
2
)
np0
=
numroc
(
nn
,
nb
,
0
,
0
,
nprow
)
mq0
=
numroc
(
MAX
(
MAX
(
neigd
,
nb
),
2
),
nb
,
0
,
0
,
npcol
)
if
(
l_real
)
THEN
if
(
hamovlp
%
l_real
)
THEN
lwork2
=
5
*
m
+
MAX
(
5
*
nn
,
np0
*
mq0
+2
*
nb
*
nb
)
+
iceil
(
neigd
,
nprow
*
npcol
)
*
nn
ALLOCATE
(
work2_r
(
lwork2
+10
*
m
),
stat
=
err
)
! Allocate more in case of clusters
else
...
...
@@ -293,7 +291,7 @@ CONTAINS
!
! Compute size of workspace
!
if
(
l_real
)
THEN
if
(
hamovlp
%
l_real
)
THEN
uplo
=
'U'
CALL
CPP_LAPACK_pdsygvx
(
1
,
'V'
,
'I'
,
'U'
,
m
,
asca_r
,
1
,
1
,
desca
,
bsca_r
,
1
,
1
,
desca
,&
0.0
,
1.0
,
1
,
num
,
abstol
,
num1
,
num2
,
eig2
,
orfac
,
eigvec_r
,
1
,
1
,&
...
...
@@ -352,7 +350,7 @@ endif
!
! Now solve generalized eigenvalue problem
!
if
(
l_real
)
THEN
if
(
hamovlp
%
l_real
)
THEN
CALL
CPP_LAPACK_pdsygvx
(
1
,
'V'
,
'I'
,
'U'
,
m
,
asca_r
,
1
,
1
,
desca
,
bsca_r
,
1
,
1
,
desca
,&
1.0
,
1.0
,
1
,
num
,
abstol
,
num1
,
num2
,
eig2
,
orfac
,
eigvec_r
,
1
,
1
,&
desceigv
,
work2_r
,
lwork2
,
iwork
,
liwork
,
ifail
,
iclustr
,&
...
...
@@ -425,15 +423,13 @@ endif
! Redistribute eigvec from ScaLAPACK distribution to each process
! having all eigenvectors corresponding to his eigenvalues as above
!
if
(
l_real
)
THEN
CALL
subredist2
(
m
,
num2
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
z_r
,
eigvec_r
)
if
(
hamovlp
%
l_real
)
THEN
CALL
subredist2
(
m
,
num2
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
z
mat
%
z
_r
,
eigvec_r
)
ELSE
CALL
subredist2
(
m
,
num2
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
z_c
,
eigvec_c
)
CALL
subredist2
(
m
,
num2
,
myrowssca
,
SUB_COMM
,
nprow
,
npcol
,
myid
,
ierr
,
nb
,
z
mat
%
z
_c
,
eigvec_c
)
end
if
!
!DEALLOCATE ( eigvec)
DEALLOCATE
(
asca
)
DEALLOCATE
(
bsca
)
DEALLOCATE
(
iblacsnums
)
DEALLOCATE
(
ihelp
)
DEALLOCATE
(
iusermap
)
...
...
diagonalization/eigen_diag.F90
View file @
8af7d700
...
...
@@ -175,7 +175,7 @@ CONTAINS
#endif
#ifdef CPP_SCALAPACK
CASE
(
diag_scalapack
)
CALL
chani
(
lapw
%
nmat
,
dimension
%
nbasfcn
/
n_size
,
ndim
,
n_rank
,
n_size
,
SUB_COMM
,
mpi
%
mpi_comm
,
eig
,
ne_found
,
hamOvlp
%
a_r
,
hamOvlp
%
b_r
,
zMat
%
z_r
,
hamOvlp
%
a_c
,
hamOvlp
%
b_c
,
zMat
%
z_c
)
CALL
chani
(
lapw
%
nmat
,
dimension
%
nbasfcn
/
n_size
,
ndim
,
n_rank
,
n_size
,
SUB_COMM
,
mpi
%
mpi_comm
,
eig
,
ne_found
,
hamOvlp
,
zMat
)
#endif
#ifdef CPP_MAGMA
CASE
(
diag_magma
)
...
...
diagonalization/ssubredist1.F90
View file @
8af7d700
...
...
@@ -3,7 +3,9 @@
! 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_subredist1
CONTAINS
!DEC$ FREEFORM
SUBROUTINE
subredist1
(
n
,
lda
,
SUB_COMM
,
nprow
,
npcol
,
iam
,
ierr
,
nb
,
achi_r
,
asca_r
,
achi_c
,
asca_c
)
USE
m_juDFT
...
...
@@ -666,3 +668,4 @@ SUBROUTINE subredist1(n,lda,SUB_COMM,nprow,npcol,iam,ierr,nb,achi_r,asca_r,achi_
DEALLOCATE
(
icommcol
)
RETURN
END
SUBROUTINE
subredist1
END
\ No newline at end of file
eigen/hlomat.F90
View file @
8af7d700
...
...
@@ -42,8 +42,8 @@ CONTAINS
TYPE
(
t_tlmplm
),
INTENT
(
INOUT
)
::
tlmplm
LOGICAL
,
INTENT
(
IN
)
::
l_real
REAL
,
OPTIONAL
,
INTENT
(
INOUT
)
::
aa_r
(:)
!(matsize)
COMPLEX
,
OPTIONAL
,
INTENT
(
INOUT
)
::
aa_c
(:)
REAL
,
OPTIONAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
aa_r
(:)
!(matsize)
COMPLEX
,
OPTIONAL
,
ALLOCATABLE
,
INTENT
(
INOUT
)
::
aa_c
(:)
! ..
! .. Local Scalars ..
COMPLEX
axx
,
bxx
,
cxx
,
dtd
,
dtu
,
dtulo
,
ulotd
,
ulotu
,
ulotulo
,
utd
,
utu
,
utulo
,
chihlp
...
...
io/eig66_mpi.F90
View file @
8af7d700
...
...
@@ -39,7 +39,7 @@ CONTAINS
TYPE
(
t_data_MPI
),
POINTER
::
d
CALL
priv_find_data
(
id
,
d
)
CALL
eig66_data_storedefault
(
d
,
jspins
,
nkpts
,
nmat
,
neig
,
lmax
,
nlotot
,
nlo
,
ntype
,
l_real
,
l_soc
,
l_dos
,
l_mcd
,
l_orb
)
CALL
eig66_data_storedefault
(
d
,
jspins
,
nkpts
,
nmat
,
neig
,
lmax
,
nlotot
,
nlo
,
ntype
,
l_real
.and..not.
l_soc
,
l_soc
,
l_dos
,
l_mcd
,
l_orb
)
IF
(
PRESENT
(
n_size_opt
))
d
%
n_size
=
n_size_opt
IF
(
ALLOCATED
(
d
%
pe_ev
))
THEN
...
...
@@ -48,7 +48,7 @@ CONTAINS
d
%
eig_data
=
1E99
d
%
int_data
=
9999999
d
%
real_data
=
1E99
if
(
l_real
.and..not.
l_soc
)
THEN
if
(
d
%
l_real
.and..not.
l_soc
)
THEN
d
%
zr_data
=
0.0
else
d
%
zc_data
=
0.0
...
...
@@ -193,10 +193,10 @@ CONTAINS
IF
(
d
%
irank
==
0
)
THEN
tmp_id
=
eig66_data_newid
(
DA_mode
)
IF
(
d
%
l_dos
)
CPP_error
(
"Could not read DOS data"
)
CALL
open_eig_DA
(
tmp_id
,
nmat
,
neig
,
nkpts
,
jspins
,
lmax
,
nlo
,
ntype
,
nlotot
,
.FALSE.
,
.FALSE.
,
l_real
,
l_soc
,
.FALSE.
,
.FALSE.
,
filename
)
CALL
open_eig_DA
(
tmp_id
,
nmat
,
neig
,
nkpts
,
jspins
,
lmax
,
nlo
,
ntype
,
nlotot
,
.FALSE.
,
.FALSE.
,
d
%
l_real
,
l_soc
,
.FALSE.
,
.FALSE.
,
filename
)
DO
jspin
=
1
,
jspins
DO
nk
=
1
,
nkpts
if
(
l_real
)
THEN
if
(
d
%
l_real
)
THEN
CALL
read_eig_DA
(
tmp_id
,
nk
,
jspin
,
nv
,
i
,
k1
,
k2
,
k3
,
bk3
,
wk
,
ii
,
eig
,
el
,
ello
,
evac
,
kveclo
,
z
=
z_r
)
CALL
write_eig
(
id
,
nk
,
jspin
,
ii
,
ii
,
nv
,
nmat
,
k1
,
k2
,
k3
,
bk3
,
wk
,
eig
,
el
,
ello
,
evac
,
nlotot
,
kveclo
,
z
=
z_r
)
ELSE
...
...
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