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
54
Issues
54
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
0f724345
Commit
0f724345
authored
Jul 15, 2019
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Changed parallelisation of cdnval (DOES not compile yet)
parent
f3324cf7
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
55 additions
and
141 deletions
+55
-141
cdn/cdnval.F90
cdn/cdnval.F90
+11
-19
types/types_cdnval.f90
types/types_cdnval.f90
+44
-122
No files found.
cdn/cdnval.F90
View file @
0f724345
...
...
@@ -88,14 +88,14 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
#endif
! Local Scalars
INTEGER
::
ikpt
,
jsp_start
,
jsp_end
,
ispin
,
jsp
INTEGER
::
ikpt
,
ikpt_i
,
jsp_start
,
jsp_end
,
ispin
,
jsp
INTEGER
::
iErr
,
nbands
,
noccbd
,
iType
INTEGER
::
skip_t
,
skip_tt
,
n
Start
,
nEnd
,
n
basfcn
INTEGER
::
skip_t
,
skip_tt
,
nbasfcn
LOGICAL
::
l_orbcomprot
,
l_real
,
l_dosNdir
,
l_corespec
! Local Arrays
REAL
::
we
(
MAXVAL
(
cdnvalJob
%
noccbd
(:
kpts
%
nkpt
)))
REAL
::
eig
(
MAXVAL
(
cdnvalJob
%
noccbd
(:
kpts
%
nkpt
)))
REAL
::
we
(
MAXVAL
(
cdnvalJob
%
noccbd
(:)))
REAL
::
eig
(
MAXVAL
(
cdnvalJob
%
noccbd
(:)))
REAL
,
ALLOCATABLE
::
f
(:,:,:,:),
g
(:,:,:,:),
flo
(:,:,:,:)
! radial functions
TYPE
(
t_lapw
)
::
lapw
...
...
@@ -174,32 +174,24 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,input,banddos,cell,atoms,enpara,st
jsp
=
MERGE
(
1
,
jspin
,
noco
%
l_noco
)
DO
ikpt
=
cdnvalJob
%
ikptStart
,
cdnvalJob
%
nkptExtended
,
cdnvalJob
%
ikptIncrement
IF
(
ikpt
.GT.
kpts
%
nkpt
)
THEN
#ifdef CPP_MPI
CALL
MPI_BARRIER
(
mpi
%
mpi_comm
,
iErr
)
! Synchronizes the RMA operations
#endif
EXIT
END
IF
DO
ikpt_i
=
1
,
size
(
cdnvalJob
%
k_list
)
ikpt
=
cdnvalJob
%
k_list
(
ikpt_i
)
CALL
lapw
%
init
(
input
,
noco
,
kpts
,
atoms
,
sym
,
ikpt
,
cell
,
.false.
,
mpi
)
skip_t
=
skip_tt
noccbd
=
cdnvalJob
%
noccbd
(
ikpt
)
nStart
=
cdnvalJob
%
nStart
(
ikpt
)
nEnd
=
cdnvalJob
%
nEnd
(
ikpt
)
we
(
1
:
noccbd
)
=
cdnvalJob
%
weights
(
1
:
noccbd
,
ikpt
)
eig
(
1
:
noccbd
)
=
results
%
eig
(
nStart
:
nEnd
,
ikpt
,
jsp
)
eig
(
1
:
noccbd
)
=
results
%
eig
(
cdnvalJob
%
ev_list
(
1
:
noccbd
)
,
ikpt
,
jsp
)
IF
(
cdnvalJob
%
l_evp
)
THEN
IF
(
nStart
>
skip_tt
)
skip_t
=
0
IF
(
nEnd
<=
skip_tt
)
skip_t
=
noccbd
IF
((
nStart
<=
skip_tt
)
.AND.
(
nEnd
>
skip_tt
))
skip_t
=
mod
(
skip_tt
,
noccbd
)
IF
(
minval
(
cdnvalJob
%
ev_list
(
1
:
noccbd
))
>
skip_tt
)
skip_t
=
0
IF
(
maxval
(
cdnvalJob
%
ev_list
(
1
:
noccbd
))
<=
skip_tt
)
skip_t
=
noccbd
IF
((
minval
(
cdnvalJob
%
ev_list
(
1
:
noccbd
))
<=
skip_tt
)
.AND.
(
maxval
(
cdnvalJob
%
ev_list
(
1
:
noccbd
))
>
skip_tt
))
skip_t
=
mod
(
skip_tt
,
noccbd
)
END
IF
nbasfcn
=
MERGE
(
lapw
%
nv
(
1
)
+
lapw
%
nv
(
2
)
+2
*
atoms
%
nlotot
,
lapw
%
nv
(
1
)
+
atoms
%
nlotot
,
noco
%
l_noco
)
CALL
zMat
%
init
(
l_real
,
nbasfcn
,
noccbd
)
CALL
read_eig
(
eig_id
,
ikpt
,
jsp
,
n_start
=
nStart
,
n_end
=
nEnd
,
neig
=
nbands
,
zmat
=
zMat
)
CALL
read_eig
(
eig_id
,
ikpt
,
jsp
,
list
=
cdnvaljob
%
ev_list
(
1
:
noccbd
)
,
neig
=
nbands
,
zmat
=
zMat
)
#ifdef CPP_MPI
CALL
MPI_BARRIER
(
mpi
%
mpi_comm
,
iErr
)
! Synchronizes the RMA operations
#endif
...
...
types/types_cdnval.f90
View file @
0f724345
...
...
@@ -119,15 +119,10 @@ PRIVATE
END
TYPE
t_orbcomp
TYPE
t_cdnvalJob
INTEGER
::
ikptIncrement
INTEGER
::
ikptStart
INTEGER
::
nkptExtended
LOGICAL
::
l_evp
INTEGER
,
ALLOCATABLE
::
k_list
(:)
INTEGER
,
ALLOCATABLE
::
ev_list
(:)
INTEGER
,
ALLOCATABLE
::
noccbd
(:)
INTEGER
,
ALLOCATABLE
::
nStart
(:)
INTEGER
,
ALLOCATABLE
::
nEnd
(:)
REAL
,
ALLOCATABLE
::
weights
(:,:)
! weights(band_idx, kpt_idx)
CONTAINS
...
...
@@ -466,142 +461,69 @@ SUBROUTINE cdnvalJob_init(thisCdnvalJob,mpi,input,kpts,noco,results,jspin,slicep
INTEGER
,
INTENT
(
IN
)
::
jspin
INTEGER
::
jsp
,
iBand
,
ikpt
,
nslibd
,
noccbd_l
,
noccbd
,
nStart
,
nEnd
thisCdnvalJob
%
l_evp
=
.FALSE.
IF
(
kpts
%
nkpt
<
mpi
%
isize
)
THEN
thisCdnvalJob
%
l_evp
=
.TRUE.
thisCdnvalJob
%
nkptExtended
=
kpts
%
nkpt
thisCdnvalJob
%
ikptStart
=
1
thisCdnvalJob
%
ikptIncrement
=
1
ELSE
! the number of iterations is adjusted to the number of MPI processes to synchronize RMA operations
thisCdnvalJob
%
nkptExtended
=
(
kpts
%
nkpt
/
mpi
%
isize
+
1
)
*
mpi
%
isize
thisCdnvalJob
%
ikptStart
=
mpi
%
irank
+
1
thisCdnvalJob
%
ikptIncrement
=
mpi
%
isize
END
IF
INTEGER
::
jsp
,
iBand
,
ikpt
,
nslibd
,
noccbd_l
,
noccbd
,
ikpt_i
thisCdnvalJob
%
l_evp
=
mpi
%
n_size
>
1
IF
(
ALLOCATED
(
thisCdnvalJob
%
k_list
))
DEALLOCATE
(
thisCdnvalJob
%
k_list
)
IF
(
ALLOCATED
(
thisCdnvalJob
%
ev_list
))
DEALLOCATE
(
thisCdnvalJob
%
ev_list
)
thisCdnvalJob
%
k_list
=
mpi
%
k_list
!includes allocate
thisCdnvalJob
%
ev_list
=
mpi
%
ev_list
IF
(
ALLOCATED
(
thisCdnvalJob
%
noccbd
))
DEALLOCATE
(
thisCdnvalJob
%
noccbd
)
IF
(
ALLOCATED
(
thisCdnvalJob
%
nStart
))
DEALLOCATE
(
thisCdnvalJob
%
nStart
)
IF
(
ALLOCATED
(
thisCdnvalJob
%
nEnd
))
DEALLOCATE
(
thisCdnvalJob
%
nEnd
)
IF
(
ALLOCATED
(
thisCdnvalJob
%
weights
))
DEALLOCATE
(
thisCdnvalJob
%
weights
)
ALLOCATE
(
thisCdnvalJob
%
noccbd
(
kpts
%
nkpt
))
ALLOCATE
(
thisCdnvalJob
%
nStart
(
kpts
%
nkpt
))
ALLOCATE
(
thisCdnvalJob
%
nEnd
(
kpts
%
nkpt
))
ALLOCATE
(
thisCdnvalJob
%
noccbd
(
size
(
thiscdnvaljob
%
k_list
)
))
ALLOCATE
(
thisCdnvalJob
%
weights
(
size
(
thiscdnvaljob
%
ev_list
),
size
(
thiscdnvalJob
%
k_list
)
))
thisCdnvalJob
%
weights
(:,:)
=
results
%
w_iks
(
thiscdnvaljob
%
ev_list
,:,
jsp
)
*
2.0
/
input
%
jspins
thisCdnvalJob
%
noccbd
=
0
thisCdnvalJob
%
nStart
=
1
thisCdnvalJob
%
nEnd
=
-1
jsp
=
MERGE
(
1
,
jspin
,
noco
%
l_noco
)
! determine bands to be used for each k point, MPI process
DO
ikpt
=
thisCdnvalJob
%
ikptStart
,
kpts
%
nkpt
,
thisCdnvalJob
%
ikptIncrement
iBand
=
results
%
neig
(
ikpt
,
jsp
)
DO
WHILE
(
results
%
w_iks
(
iBand
,
ikpt
,
jsp
)
.LT.
1.e-8
)
iBand
=
iBand
-
1
END
DO
thisCdnvalJob
%
noccbd
(
ikpt
)
=
iBand
! DO iBand = 1,results%neig(ikpt,jsp)
! IF ((results%w_iks(iBand,ikpt,jsp).GE.1.e-8).OR.input%pallst) THEN
! thisCdnvalJob%noccbd(ikpt) = thisCdnvalJob%noccbd(ikpt) + 1
! END IF
! END DO
IF
(
PRESENT
(
banddos
))
THEN
IF
(
banddos
%
dos
)
thisCdnvalJob
%
noccbd
(
ikpt
)
=
results
%
neig
(
ikpt
,
jsp
)
END
IF
thisCdnvalJob
%
nStart
(
ikpt
)
=
1
thisCdnvalJob
%
nEnd
(
ikpt
)
=
thisCdnvalJob
%
noccbd
(
ikpt
)
DO
ikpt_i
=
1
,
size
(
thisCdnvalJob
%
k_list
)
ikpt
=
thisCdnvalJob
%
k_list
(
ikpt_i
)
IF
(
PRESENT
(
sliceplot
))
THEN
IF
(
sliceplot
%
slice
.AND.
input
%
pallst
)
thisCdnvalJob
%
weights
(:,
ikpt
)
=
kpts
%
wtkpt
(
ikpt
)
END
IF
!Max number of bands
thisCdnvalJob
%
noccbd
(
ikpt
)
=
count
(
thiscdnvaljob
%
ev_list
<=
results
%
neig
(
ikpt
,
jsp
))
!---> if slice, only certain bands are taken into account
IF
(
PRESENT
(
sliceplot
))
THEN
IF
(
sliceplot
%
slice
.AND.
thisCdnvalJob
%
noccbd
(
ikpt
)
.GT.
0
)
THEN
thisCdnvalJob
%
nStart
(
ikpt
)
=
1
thisCdnvalJob
%
nEnd
(
ikpt
)
=
-1
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
FMT
=*
)
'NNNE'
,
sliceplot
%
nnne
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
FMT
=*
)
'sliceplot%kk'
,
sliceplot
%
kk
nslibd
=
0
IF
(
sliceplot
%
kk
.EQ.
0
)
THEN
IF
(
mpi
%
irank
==
0
)
THEN
WRITE
(
6
,
FMT
=
'(a)'
)
'ALL K-POINTS ARE TAKEN IN SLICE'
WRITE
(
6
,
FMT
=
'(a,i2)'
)
' sliceplot%slice: k-point nr.'
,
ikpt
END
IF
iBand
=
1
DO
WHILE
(
results
%
eig
(
iBand
,
ikpt
,
jsp
)
.LT.
sliceplot
%
e1s
)
iBand
=
iBand
+
1
IF
(
iBand
.GT.
results
%
neig
(
ikpt
,
jsp
))
EXIT
END
DO
thisCdnvalJob
%
nStart
(
ikpt
)
=
iBand
IF
(
iBand
.LE.
results
%
neig
(
ikpt
,
jsp
))
THEN
DO
WHILE
(
results
%
eig
(
iBand
,
ikpt
,
jsp
)
.LE.
sliceplot
%
e2s
)
iBand
=
iBand
+
1
IF
(
iBand
.GT.
results
%
neig
(
ikpt
,
jsp
))
EXIT
END
DO
iBand
=
iBand
-
1
END
IF
thisCdnvalJob
%
nEnd
(
ikpt
)
=
iBand
nslibd
=
MAX
(
0
,
thisCdnvalJob
%
nEnd
(
ikpt
)
-
thisCdnvalJob
%
nStart
(
ikpt
)
+
1
)
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
'(a,i3)'
)
' eigenvalues in sliceplot%slice:'
,
nslibd
do
iband
=
1
,
thisCdnvalJob
%
noccbd
(
ikpt
)
if
(
results
%
eig
(
thiscdnvaljob
%
ev_list
(
iBand
),
ikpt
,
jsp
)
.LT.
sliceplot
%
e1s
)
thisCdnvalJob
%
weights
(
iband
,
ikpt
)
=
0.0
if
(
results
%
eig
(
thiscdnvaljob
%
ev_list
(
iBand
),
ikpt
,
jsp
)
.GT.
sliceplot
%
e2s
)
thisCdnvalJob
%
weights
(
iband
,
ikpt
)
=
0.0
end
do
ELSE
IF
(
sliceplot
%
kk
.EQ.
ikpt
)
THEN
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
FMT
=
'(a,i2)'
)
' sliceplot%slice: k-point nr.'
,
ikpt
IF
((
sliceplot
%
e1s
.EQ.
0.0
)
.AND.
(
sliceplot
%
e2s
.EQ.
0.0
))
THEN
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
FMT
=
'(a,i5,f10.5)'
)
'slice: eigenvalue nr.'
,&
sliceplot
%
nnne
,
results
%
eig
(
sliceplot
%
nnne
,
ikpt
,
jsp
)
nslibd
=
1
thisCdnvalJob
%
nStart
(
ikpt
)
=
sliceplot
%
nnne
thisCdnvalJob
%
nEnd
(
ikpt
)
=
sliceplot
%
nnne
do
iband
=
1
,
thisCdnvalJob
%
noccbd
(
ikpt
)
if
(
thiscdnvaljob
%
ev_list
(
iBand
)
.ne.
sliceplot
%
nnne
)
thisCdnvalJob
%
weights
(
iband
,
ikpt
)
=
0.0
enddo
ELSE
iBand
=
1
DO
WHILE
(
results
%
eig
(
iBand
,
ikpt
,
jsp
)
.LT.
sliceplot
%
e1s
)
iBand
=
iBand
+
1
IF
(
iBand
.GT.
results
%
neig
(
ikpt
,
jsp
))
EXIT
END
DO
thisCdnvalJob
%
nStart
(
ikpt
)
=
iBand
IF
(
iBand
.LE.
results
%
neig
(
ikpt
,
jsp
))
THEN
DO
WHILE
(
results
%
eig
(
iBand
,
ikpt
,
jsp
)
.LE.
sliceplot
%
e2s
)
iBand
=
iBand
+
1
IF
(
iBand
.GT.
results
%
neig
(
ikpt
,
jsp
))
EXIT
END
DO
iBand
=
iBand
-
1
END
IF
thisCdnvalJob
%
nEnd
(
ikpt
)
=
iBand
nslibd
=
MAX
(
0
,
thisCdnvalJob
%
nEnd
(
ikpt
)
-
thisCdnvalJob
%
nStart
(
ikpt
)
+
1
)
IF
(
mpi
%
irank
==
0
)
WRITE
(
6
,
FMT
=
'(a,i3)'
)
' eigenvalues in sliceplot%slice:'
,
nslibd
do
iband
=
1
,
thisCdnvalJob
%
noccbd
(
ikpt
)
if
(
results
%
eig
(
thiscdnvaljob
%
ev_list
(
iBand
),
ikpt
,
jsp
)
.LT.
sliceplot
%
e1s
)
thisCdnvalJob
%
weights
(
iband
,
ikpt
)
=
0.0
if
(
results
%
eig
(
thiscdnvaljob
%
ev_list
(
iBand
),
ikpt
,
jsp
)
.GT.
sliceplot
%
e2s
)
thisCdnvalJob
%
weights
(
iband
,
ikpt
)
=
0.0
end
do
END
IF
else
thisCdnvalJob
%
weights
(:,
ikpt
)
=
0.0
END
IF
thisCdnvalJob
%
noccbd
(
ikpt
)
=
nslibd
END
IF
! sliceplot%slice
END
IF
IF
(
thisCdnvalJob
%
l_evp
)
THEN
noccbd_l
=
CEILING
(
REAL
(
thisCdnvalJob
%
noccbd
(
ikpt
))
/
mpi
%
isize
)
thisCdnvalJob
%
nEnd
(
ikpt
)
=
min
(
thisCdnvalJob
%
nStart
(
ikpt
)
+
(
mpi
%
irank
+1
)
*
noccbd_l
-1
,
thisCdnvalJob
%
noccbd
(
ikpt
))
thisCdnvalJob
%
nStart
(
ikpt
)
=
thisCdnvalJob
%
nStart
(
ikpt
)
+
mpi
%
irank
*
noccbd_l
thisCdnvalJob
%
noccbd
(
ikpt
)
=
thisCdnvalJob
%
nEnd
(
ikpt
)
-
thisCdnvalJob
%
nStart
(
ikpt
)
+
1
IF
(
thisCdnvalJob
%
noccbd
(
ikpt
)
.LT.
1
)
thisCdnvalJob
%
noccbd
(
ikpt
)
=
0
END
IF
END
DO
IF
(
ALLOCATED
(
thisCdnvalJob
%
weights
))
DEALLOCATE
(
thisCdnvalJob
%
weights
)
ALLOCATE
(
thisCdnvalJob
%
weights
(
MAXVAL
(
thisCdnvalJob
%
noccbd
(:)),
kpts
%
nkpt
))
thisCdnvalJob
%
weights
=
0.0
DO
ikpt
=
thisCdnvalJob
%
ikptStart
,
kpts
%
nkpt
,
thisCdnvalJob
%
ikptIncrement
noccbd
=
thisCdnvalJob
%
noccbd
(
ikpt
)
nStart
=
thisCdnvalJob
%
nStart
(
ikpt
)
nEnd
=
thisCdnvalJob
%
nEnd
(
ikpt
)
thisCdnvalJob
%
weights
(
1
:
noccbd
,
ikpt
)
=
results
%
w_iks
(
nStart
:
nEnd
,
ikpt
,
jsp
)
IF
(
PRESENT
(
sliceplot
))
THEN
IF
(
sliceplot
%
slice
.AND.
input
%
pallst
)
thisCdnvalJob
%
weights
(:,
ikpt
)
=
kpts
%
wtkpt
(
ikpt
)
END
IF
thisCdnvalJob
%
weights
(:
noccbd
,
ikpt
)
=
2.0
*
thisCdnvalJob
%
weights
(:
noccbd
,
ikpt
)
/
input
%
jspins
! add in spin-doubling factor
!remove unoccupied states
iband
=
thisCdnvalJob
%
noccbd
(
ikpt
)
IF
(
PRESENT
(
banddos
))
THEN
IF
(
.NOT.
banddos
%
dos
)
THEN
DO
WHILE
(
thisCdnvalJob
%
weights
(
iBand
,
ikpt
)
.LT.
1.e-8
)
iBand
=
iBand
-
1
END
DO
ENDIF
ENDIF
thisCdnvalJob
%
noccbd
(
ikpt
)
=
iBand
END
DO
END
SUBROUTINE
cdnvalJob_init
...
...
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