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
d53442bd
Commit
d53442bd
authored
Jan 09, 2019
by
Matthias Redies
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' into MetaGGA
parents
150ef126
873645c9
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
119 additions
and
101 deletions
+119
-101
cdn/qal_21.f90
cdn/qal_21.f90
+1
-1
diagonalization/chase_diag.F90
diagonalization/chase_diag.F90
+2
-1
eigen/eigen_hssetup.F90
eigen/eigen_hssetup.F90
+2
-0
io/loddop.f90
io/loddop.f90
+74
-68
io/wrtdop.f90
io/wrtdop.f90
+30
-23
main/fleur.F90
main/fleur.F90
+1
-1
mix/potdis.f90
mix/potdis.f90
+1
-1
vgen/vmts.F90
vgen/vmts.F90
+8
-6
No files found.
cdn/qal_21.f90
View file @
d53442bd
...
...
@@ -41,7 +41,7 @@ CONTAINS
! .. Intrinsic Functions ..
INTRINSIC
conjg
qal21
=
0.0
!---> l-decomposed density for each occupied state
states
:
DO
i
=
1
,
noccbd
nt1
=
1
...
...
diagonalization/chase_diag.F90
View file @
d53442bd
...
...
@@ -88,7 +88,7 @@ CONTAINS
END
SUBROUTINE
chase_distance
#ifdef CPP_CHASE
SUBROUTINE
init_chase
(
mpi
,
DIMENSION
,
atoms
,
kpts
,
noco
,
l_real
)
SUBROUTINE
init_chase
(
mpi
,
DIMENSION
,
input
,
atoms
,
kpts
,
noco
,
l_real
)
USE
m_types_mpimat
USE
m_types
USE
m_types_mpi
...
...
@@ -99,6 +99,7 @@ CONTAINS
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
...
...
eigen/eigen_hssetup.F90
View file @
d53442bd
...
...
@@ -95,8 +95,10 @@ CONTAINS
! In the parallel case also a redistribution happens
ALLOCATE
(
smat_final
,
mold
=
smat
(
1
,
1
))
ALLOCATE
(
hmat_final
,
mold
=
smat
(
1
,
1
))
CALL
timestart
(
"Matrix redistribution"
)
CALL
eigen_redist_matrix
(
mpi
,
lapw
,
atoms
,
smat
,
smat_final
)
CALL
eigen_redist_matrix
(
mpi
,
lapw
,
atoms
,
hmat
,
hmat_final
,
smat_final
)
CALL
timestop
(
"Matrix redistribution"
)
END
SUBROUTINE
eigen_hssetup
END
MODULE
m_eigen_hssetup
...
...
io/loddop.f90
View file @
d53442bd
...
...
@@ -24,8 +24,9 @@
INTEGER
,
INTENT
(
OUT
)::
it
! ..
! .. Array Arguments ..
COMPLEX
,
INTENT
(
OUT
)::
fpw
(
stars
%
ng3
,
input
%
jspins
),
fzxy
(
vacuum
%
nmzxyd
,
stars
%
ng2
-1
,
2
,
input
%
jspins
)
REAL
,
INTENT
(
OUT
)::
fr
(
atoms
%
jmtd
,
0
:
sphhar
%
nlhd
,
atoms
%
ntype
,
input
%
jspins
),
fz
(
vacuum
%
nmzd
,
2
,
input
%
jspins
)
COMPLEX
,
INTENT
(
OUT
)::
fpw
(:,:),
fzxy
(:,:,:,:)
!(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL
,
INTENT
(
OUT
)::
fr
(:,
0
:,:,:)
!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
REAL
,
INTENT
(
OUT
)::
fz
(:,:,:)
!(vacuum%nmzd,2,input%jspins)
CHARACTER
(
len
=
8
)
::
dop
,
iop
,
name
(
10
)
! ..
! .. Local Scalars ..
...
...
@@ -48,15 +49,15 @@
fr
=
0
;
fzxy
=
0
;
fr
=
0
;
fz
=
0
IF
(
sym
%
invs
)
ALLOCATE
(
fpwr
(
stars
%
ng3
,
input
%
jspins
)
)
IF
(
sym
%
invs2
)
ALLOCATE
(
fzxyr
(
vacuum
%
nmzxyd
,
stars
%
ng2
-1
,
2
,
input
%
jspins
)
)
IF
(
sym
%
invs
)
ALLOCATE
(
fpwr
(
stars
%
ng3
,
SIZE
(
fpw
,
2
)
)
)
IF
(
sym
%
invs2
)
ALLOCATE
(
fzxyr
(
vacuum
%
nmzxyd
,
stars
%
ng2
-1
,
2
,
SIZE
(
fzxy
,
4
)
)
)
name
=
space
READ
(
nu
,
END
=
200
,
ERR
=
200
)
name
! WRITE (*,FMT=8000) name
! 8000 FORMAT (' loddop title:',10a8)
READ
(
nu
,
END
=
200
,
ERR
=
200
)
iop
,
dop
,
it
DO
jsp
=
1
,
input
%
jspins
DO
jsp
=
1
,
SIZE
(
fr
,
4
)
READ
(
nu
,
END
=
200
,
ERR
=
200
)
jspdum
READ
(
nu
,
END
=
200
,
ERR
=
200
)
nn
IF
(
nn
/
=
atoms
%
ntype
)
CALL
juDFT_error
(
"nn.NE.ntype"
,
calledby
=
&
...
...
@@ -94,76 +95,81 @@
na
=
na
+
atoms
%
neq
(
n
)
ENDDO
READ
(
nu
,
END
=
200
,
ERR
=
200
)
nq3n
!+gu
IF
(
nq3n
.GT.
stars
%
ng3
)
THEN
WRITE
(
*
,
*
)
'nq3n ('
,
nq3n
,
') reduced to nq3 ('
,
stars
%
ng3
,
')'
nq3n
=
stars
%
ng3
IF
(
jsp
<=
SIZE
(
fpw
,
2
))
THEN
READ
(
nu
,
END
=
200
,
ERR
=
200
)
nq3n
!+gu
IF
(
nq3n
.GT.
stars
%
ng3
)
THEN
WRITE
(
*
,
*
)
'nq3n ('
,
nq3n
,
') reduced to nq3 ('
,
stars
%
ng3
,
')'
nq3n
=
stars
%
ng3
ENDIF
!-gu
IF
(
sym
%
invs
)
THEN
READ
(
nu
,
END
=
200
,
ERR
=
200
)
(
fpwr
(
k
,
jsp
),
k
=
1
,
nq3n
)
fpw
(:
nq3n
,
jsp
)
=
CMPLX
(
fpwr
(:
nq3n
,
jsp
),
0.
)
ELSE
READ
(
nu
,
END
=
200
,
ERR
=
200
)
(
fpw
(
k
,
jsp
),
k
=
1
,
nq3n
)
END
IF
IF
(
nq3n
.LT.
stars
%
ng3
)
THEN
fpw
(
nq3n
+1
:,
jsp
)
=
(
0.
,
0.
)
END
IF
ENDIF
!-gu
IF
(
sym
%
invs
)
THEN
READ
(
nu
,
END
=
200
,
ERR
=
200
)
(
fpwr
(
k
,
jsp
),
k
=
1
,
nq3n
)
fpw
(:
nq3n
,
jsp
)
=
CMPLX
(
fpwr
(:
nq3n
,
jsp
),
0.
)
ELSE
READ
(
nu
,
END
=
200
,
ERR
=
200
)
(
fpw
(
k
,
jsp
),
k
=
1
,
nq3n
)
END
IF
IF
(
nq3n
.LT.
stars
%
ng3
)
THEN
fpw
(
nq3n
+1
:,
jsp
)
=
(
0.
,
0.
)
END
IF
IF
(
input
%
film
)
THEN
DO
ivac
=
1
,
vacuum
%
nvac
READ
(
nu
,
END
=
200
,
ERR
=
200
)
ivdummy
READ
(
nu
,
END
=
200
,
ERR
=
200
)
nmzn
,
z1n
,
delzn
READ
(
nu
,
END
=
200
,
ERR
=
200
)
(
fz
(
i
,
ivac
,
jsp
),
i
=
1
,
nmzn
)
IF
(
vacuum
%
nvac
.EQ.
1
)
THEN
DO
i
=
1
,
nmzn
fz
(
i
,
2
,
jsp
)
=
fz
(
i
,
1
,
jsp
)
ENDDO
ENDIF
READ
(
nu
,
END
=
200
,
ERR
=
200
)
nq2n
,
nmzxyn
!+gu
IF
(
nq2n
.GT.
stars
%
ng2
)
THEN
WRITE
(
*
,
*
)
'nq2n ('
,
nq2n
,
') reduced to nq2 ('
,
stars
%
ng2
,
')'
n_diff
=
nq2n
-
stars
%
ng2
nq2n
=
stars
%
ng2
ELSE
n_diff
=
0
ENDIF
!-gu
DO
k
=
2
,
nq2n
IF
(
sym
%
invs2
)
THEN
READ
(
nu
,
END
=
200
,
ERR
=
200
)
&
&
(
fzxyr
(
j
,
k
-1
,
ivac
,
jsp
),
j
=
1
,
nmzxyn
)
fzxy
(:
nmzxyn
,
k
-1
,
ivac
,
jsp
)
=
CMPLX
(
fzxyr
(:
nmzxyn
,
k
-1
,
ivac
,&
&
jsp
),
0.
)
ELSE
READ
(
nu
,
END
=
200
,
ERR
=
200
)
&
&
(
fzxy
(
j
,
k
-1
,
ivac
,
jsp
),
j
=
1
,
nmzxyn
)
END
IF
IF
(
jsp
<=
SIZE
(
fz
,
3
))
THEN
DO
ivac
=
1
,
vacuum
%
nvac
READ
(
nu
,
END
=
200
,
ERR
=
200
)
ivdummy
READ
(
nu
,
END
=
200
,
ERR
=
200
)
nmzn
,
z1n
,
delzn
READ
(
nu
,
END
=
200
,
ERR
=
200
)
(
fz
(
i
,
ivac
,
jsp
),
i
=
1
,
nmzn
)
IF
(
vacuum
%
nvac
.EQ.
1
)
THEN
IF
(
sym
%
invs
)
THEN
DO
j
=
1
,
nmzxyn
fzxy
(
j
,
k
-1
,
2
,
jsp
)
=
CONJG
(
fzxy
(
j
,
k
-1
,
1
,
jsp
))
ENDDO
DO
i
=
1
,
nmzn
fz
(
i
,
2
,
jsp
)
=
fz
(
i
,
1
,
jsp
)
ENDDO
ENDIF
IF
(
jsp
<=
SIZE
(
fzxy
,
4
))
THEN
READ
(
nu
,
END
=
200
,
ERR
=
200
)
nq2n
,
nmzxyn
!+gu
IF
(
nq2n
.GT.
stars
%
ng2
)
THEN
WRITE
(
*
,
*
)
'nq2n ('
,
nq2n
,
') reduced to nq2 ('
,
stars
%
ng2
,
')'
n_diff
=
nq2n
-
stars
%
ng2
nq2n
=
stars
%
ng2
ELSE
DO
j
=
1
,
nmzxyn
fzxy
(
j
,
k
-1
,
2
,
jsp
)
=
fzxy
(
j
,
k
-1
,
1
,
jsp
)
ENDDO
n_diff
=
0
ENDIF
!-gu
DO
k
=
2
,
nq2n
IF
(
sym
%
invs2
)
THEN
READ
(
nu
,
END
=
200
,
ERR
=
200
)
&
&
(
fzxyr
(
j
,
k
-1
,
ivac
,
jsp
),
j
=
1
,
nmzxyn
)
fzxy
(:
nmzxyn
,
k
-1
,
ivac
,
jsp
)
=
CMPLX
(
fzxyr
(:
nmzxyn
,
k
-1
,
ivac
,&
&
jsp
),
0.
)
ELSE
READ
(
nu
,
END
=
200
,
ERR
=
200
)
&
&
(
fzxy
(
j
,
k
-1
,
ivac
,
jsp
),
j
=
1
,
nmzxyn
)
END
IF
IF
(
vacuum
%
nvac
.EQ.
1
)
THEN
IF
(
sym
%
invs
)
THEN
DO
j
=
1
,
nmzxyn
fzxy
(
j
,
k
-1
,
2
,
jsp
)
=
CONJG
(
fzxy
(
j
,
k
-1
,
1
,
jsp
))
ENDDO
ELSE
DO
j
=
1
,
nmzxyn
fzxy
(
j
,
k
-1
,
2
,
jsp
)
=
fzxy
(
j
,
k
-1
,
1
,
jsp
)
ENDDO
ENDIF
ENDIF
ENDDO
!+gu
DO
k
=
1
,
n_diff
READ
(
nu
,
END
=
200
,
ERR
=
200
)
dummy
ENDDO
!-gu
IF
(
nq2n
.LT.
stars
%
ng2
)
THEN
fzxy
(:
nmzxyn
,
nq2n
:,
ivac
,
jsp
)
=
(
0.
,
0.
)
END
IF
ENDIF
ENDDO
!+gu
DO
k
=
1
,
n_diff
READ
(
nu
,
END
=
200
,
ERR
=
200
)
dummy
ENDDO
!-gu
IF
(
nq2n
.LT.
stars
%
ng2
)
THEN
fzxy
(:
nmzxyn
,
nq2n
:,
ivac
,
jsp
)
=
(
0.
,
0.
)
END
IF
ENDDO
END
IF
END
IF
ENDIF
ENDDO
!
IF
(
sym
%
invs
)
DEALLOCATE
(
fpwr
)
...
...
io/wrtdop.f90
View file @
d53442bd
...
...
@@ -25,8 +25,9 @@
INTEGER
,
INTENT
(
IN
)
::
it
! ..
! .. Array Arguments ..
COMPLEX
,
INTENT
(
IN
)::
fpw
(
stars
%
ng3
,
input
%
jspins
),
fzxy
(
vacuum
%
nmzxyd
,
stars
%
ng2
-1
,
2
,
input
%
jspins
)
REAL
,
INTENT
(
IN
)::
fr
(
atoms
%
jmtd
,
0
:
sphhar
%
nlhd
,
atoms
%
ntype
,
input
%
jspins
),
fz
(
vacuum
%
nmzd
,
2
,
input
%
jspins
)
COMPLEX
,
INTENT
(
IN
)::
fpw
(:,:),
fzxy
(:,:,:,:)
!(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
REAL
,
INTENT
(
IN
)::
fr
(:,
0
:,:,:)
!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),
REAL
,
INTENT
(
IN
)::
fz
(:,:,:)
!(vacuum%nmzd,2,input%jspins)
CHARACTER
(
len
=
8
)::
dop
,
iop
,
name
(
10
)
! .. Local Scalars ..
INTEGER
i
,
ivac
,
izn
,
jsp
,
k
,
lh
,
n
,
na
...
...
@@ -44,7 +45,7 @@
! WRITE (6,FMT=8000) name
8000
FORMAT
(
' wrtdop title:'
,
10a8
)
WRITE
(
nu
)
iop
,
dop
,
it
DO
jsp
=
1
,
input
%
jspins
DO
jsp
=
1
,
SIZE
(
fr
,
4
)
WRITE
(
nu
)
jsp
WRITE
(
nu
)
atoms
%
ntype
na
=
1
...
...
@@ -58,27 +59,33 @@
ENDDO
na
=
na
+
atoms
%
neq
(
n
)
ENDDO
WRITE
(
nu
)
stars
%
ng3
IF
(
sym
%
invs
)
THEN
WRITE
(
nu
)
(
REAL
(
fpw
(
k
,
jsp
)),
k
=
1
,
stars
%
ng3
)
ELSE
WRITE
(
nu
)
(
fpw
(
k
,
jsp
),
k
=
1
,
stars
%
ng3
)
END
IF
IF
(
jsp
<=
SIZE
(
fpw
,
2
))
THEN
WRITE
(
nu
)
stars
%
ng3
IF
(
sym
%
invs
)
THEN
WRITE
(
nu
)
(
REAL
(
fpw
(
k
,
jsp
)),
k
=
1
,
stars
%
ng3
)
ELSE
WRITE
(
nu
)
(
fpw
(
k
,
jsp
),
k
=
1
,
stars
%
ng3
)
END
IF
ENDIF
IF
(
input
%
film
)
THEN
DO
ivac
=
1
,
vacuum
%
nvac
WRITE
(
nu
)
ivac
WRITE
(
nu
)
vacuum
%
nmz
,
vacuum
%
dvac
,
vacuum
%
delz
WRITE
(
nu
)
(
fz
(
i
,
ivac
,
jsp
),
i
=
1
,
vacuum
%
nmz
)
WRITE
(
nu
)
stars
%
ng2
,
vacuum
%
nmzxy
DO
k
=
2
,
stars
%
ng2
IF
(
sym
%
invs2
)
THEN
WRITE
(
nu
)
(
REAL
(
fzxy
(
i
,
k
-1
,
ivac
,
jsp
)),
i
=
1
,
vacuum
%
nmzxy
)
ELSE
WRITE
(
nu
)
(
fzxy
(
i
,
k
-1
,
ivac
,
jsp
),
i
=
1
,
vacuum
%
nmzxy
)
END
IF
ENDDO
ENDDO
END
IF
IF
(
jsp
<=
SIZE
(
fz
,
3
))
THEN
DO
ivac
=
1
,
vacuum
%
nvac
WRITE
(
nu
)
ivac
WRITE
(
nu
)
vacuum
%
nmz
,
vacuum
%
dvac
,
vacuum
%
delz
WRITE
(
nu
)
(
fz
(
i
,
ivac
,
jsp
),
i
=
1
,
vacuum
%
nmz
)
IF
(
jsp
<=
SIZE
(
fzxy
,
4
))
THEN
WRITE
(
nu
)
stars
%
ng2
,
vacuum
%
nmzxy
DO
k
=
2
,
stars
%
ng2
IF
(
sym
%
invs2
)
THEN
WRITE
(
nu
)
(
REAL
(
fzxy
(
i
,
k
-1
,
ivac
,
jsp
)),
i
=
1
,
vacuum
%
nmzxy
)
ELSE
WRITE
(
nu
)
(
fzxy
(
i
,
k
-1
,
ivac
,
jsp
),
i
=
1
,
vacuum
%
nmzxy
)
END
IF
ENDDO
ENDIF
ENDDO
END
IF
ENDIF
ENDDO
!
RETURN
...
...
main/fleur.F90
View file @
d53442bd
...
...
@@ -169,7 +169,7 @@ CONTAINS
noco
%
l_noco
,
.TRUE.
,
l_real
,
noco
%
l_soc
,
.FALSE.
,
mpi
%
n_size
)
#ifdef CPP_CHASE
CALL
init_chase
(
mpi
,
dimension
,
atoms
,
kpts
,
noco
,
sym
%
invs
.AND..NOT.
noco
%
l_noco
)
CALL
init_chase
(
mpi
,
dimension
,
input
,
atoms
,
kpts
,
noco
,
sym
%
invs
.AND..NOT.
noco
%
l_noco
)
#endif
! Open/allocate eigenvector storage (end)
...
...
mix/potdis.f90
View file @
d53442bd
...
...
@@ -54,7 +54,7 @@ CONTAINS
REWIND
9
DO
io
=
1
,
2
CALL
loddop
(
stars
,
vacuum
,
atoms
,
sphhar
,
input
,
sym
,&
9
,
iter
,
rhsp
(
1
,
0
,
1
,
1
,
io
),
rhpw
(
1
,
1
,
io
),
rhv0
(
1
,
1
,
1
,
io
),
rhv1
(
1
,
1
,
1
,
1
,
io
))
9
,
iter
,
rhsp
(
:,
0
:,:,:,
io
),
rhpw
(:,:,
io
),
rhv0
(:,:,:,
io
),
rhv1
(:,:,:,:
,
io
))
ENDDO
CLOSE
(
9
)
IF
(
input
%
jspins
.EQ.
1
)
THEN
...
...
vgen/vmts.F90
View file @
d53442bd
...
...
@@ -64,7 +64,7 @@ contains
real
::
sbf
(
0
:
atoms
%
lmaxd
)
real
,
allocatable
,
dimension
(:,:)
::
il
,
kl
!$
COMPLEX vtl_loc(0:sphhar%nlhd,atoms%ntype
)
!$
complex, allocatable :: vtl_loc(:,:
)
#ifdef CPP_MPI
include
'mpif.h'
integer
::
ierr
(
3
)
...
...
@@ -91,7 +91,8 @@ contains
!$omp parallel default( none ) &
!$omp& shared( mpi, stars, vpw, oneD, atoms, sym, cell, sphhar, vtl ) &
!$omp& private( k, cp, pylm, nat, n, sbf, nd, lh, sm, jm, m, lm, l ) &
!$omp& private( vtl_loc )
!$omp& private( vtl_loc )
!$ allocate(vtl_loc(0:sphhar%nlhd,atoms%ntype))
!$ vtl_loc(:,:) = cmplx(0.d0,0.d0)
!$omp do
do
k
=
mpi
%
irank
+2
,
stars
%
ng3
,
mpi
%
isize
...
...
@@ -114,10 +115,10 @@ contains
lm
=
l
*
(
l
+
1
)
+
m
+
1
sm
=
sm
+
conjg
(
sphhar
%
clnu
(
jm
,
lh
,
nd
)
)
*
pylm
(
lm
,
n
)
end
do
!$ if (.false.) then
vtl
(
lh
,
n
)
=
vtl
(
lh
,
n
)
+
cp
*
sbf
(
l
)
*
sm
!$ end if
!$ vtl_loc(lh,n) = vtl_loc(lh,n) + cp * sbf(l) * sm
!$ if (.false.) then
vtl
(
lh
,
n
)
=
vtl
(
lh
,
n
)
+
cp
*
sbf
(
l
)
*
sm
!$ end if
!$ vtl_loc(lh,n) = vtl_loc(lh,n) + cp * sbf(l) * sm
end
do
nat
=
nat
+
atoms
%
neq
(
n
)
end
do
...
...
@@ -126,6 +127,7 @@ contains
!$omp critical
!$ vtl = vtl + vtl_loc
!$omp end critical
!$ deallocate(vtl_loc)
!$omp end parallel
#ifdef CPP_MPI
n1
=
(
sphhar
%
nlhd
+
1
)
*
atoms
%
ntype
...
...
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