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
bfbfae41
Commit
bfbfae41
authored
Apr 27, 2018
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove qintsl and qmtsl from read_dos
parent
a5d130c7
Changes
14
Hide whitespace changes
Inline
Side-by-side
Showing
14 changed files
with
93 additions
and
91 deletions
+93
-91
cdn/cdnval.F90
cdn/cdnval.F90
+3
-3
cdn/q_int_sl.F90
cdn/q_int_sl.F90
+3
-3
cdn/q_mt_sl.f90
cdn/q_mt_sl.f90
+1
-1
dos/Ek_write_sl.f90
dos/Ek_write_sl.f90
+8
-15
dos/doswrite.f90
dos/doswrite.f90
+4
-3
dos/evaldos.f90
dos/evaldos.f90
+14
-14
io/eig66_da.F90
io/eig66_da.F90
+8
-11
io/eig66_hdf.F90
io/eig66_hdf.F90
+4
-6
io/eig66_io.F90
io/eig66_io.F90
+10
-10
io/eig66_mem.F90
io/eig66_mem.F90
+3
-5
io/eig66_mpi.F90
io/eig66_mpi.F90
+3
-5
main/cdngen.F90
main/cdngen.F90
+1
-1
mpi/mpi_col_den.F90
mpi/mpi_col_den.F90
+21
-7
types/types_cdnval.f90
types/types_cdnval.f90
+10
-7
No files found.
cdn/cdnval.F90
View file @
bfbfae41
...
...
@@ -140,7 +140,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL
force
%
init1
(
input
,
atoms
)
CALL
orb
%
init
(
atoms
,
noco
,
jsp_start
,
jsp_end
)
CALL
mcd
%
init1
(
banddos
,
dimension
,
input
,
atoms
,
kpts
)
CALL
slab
%
init
(
banddos
,
dimension
,
atoms
,
cell
)
CALL
slab
%
init
(
banddos
,
dimension
,
atoms
,
cell
,
input
,
kpts
)
CALL
orbcomp
%
init
(
banddos
,
dimension
,
atoms
)
IF
(
denCoeffsOffdiag
%
l_fmpl
.AND.
(
.NOT.
noco
%
l_mperp
))
CALL
juDFT_error
(
"for fmpl set noco%l_mperp = T!"
,
calledby
=
"cdnval"
)
...
...
@@ -221,7 +221,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL
pwden
(
stars
,
kpts
,
banddos
,
oneD
,
input
,
mpi
,
noco
,
cell
,
atoms
,
sym
,
ikpt
,&
jspin
,
lapw
,
noccbd
,
we
,
eig
,
den
,
dos
%
qis
,
results
,
force
%
f_b8
,
zMat
)
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
IF
(
l_dosNdir
)
CALL
q_int_sl
(
jspin
,
stars
,
atoms
,
sym
,
cell
,
noccbd
,
lapw
,
slab
,
oneD
,
zMat
)
IF
(
l_dosNdir
)
CALL
q_int_sl
(
jspin
,
ikpt
,
stars
,
atoms
,
sym
,
cell
,
noccbd
,
lapw
,
slab
,
oneD
,
zMat
)
! valence density in the vacuum region
IF
(
input
%
film
)
THEN
CALL
vacden
(
vacuum
,
dimension
,
stars
,
oneD
,
kpts
,
input
,
sym
,
cell
,
atoms
,
noco
,
banddos
,&
...
...
@@ -277,7 +277,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
#ifdef CPP_MPI
DO
ispin
=
jsp_start
,
jsp_end
CALL
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
ispin
,
regCharges
,
dos
,
mcd
,&
CALL
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
ispin
,
regCharges
,
dos
,
mcd
,
slab
,
&
results
,
denCoeffs
,
orb
,
denCoeffsOffdiag
,
den
,
den
%
mmpMat
(:,:,:,
jspin
))
END
DO
#endif
...
...
cdn/q_int_sl.F90
View file @
bfbfae41
MODULE
m_qintsl
USE
m_juDFT
CONTAINS
SUBROUTINE
q_int_sl
(
isp
,
stars
,
atoms
,
sym
,
cell
,
ne
,
lapw
,
slab
,
oneD
,
zMat
)
SUBROUTINE
q_int_sl
(
isp
,
ikpt
,
stars
,
atoms
,
sym
,
cell
,
ne
,
lapw
,
slab
,
oneD
,
zMat
)
! *******************************************************
! calculate the charge of the En(k) state
! in the interstitial region of each leyer
...
...
@@ -23,7 +23,7 @@ CONTAINS
TYPE
(
t_slab
),
INTENT
(
INOUT
)::
slab
!
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
ne
,
isp
INTEGER
,
INTENT
(
IN
)
::
ne
,
isp
,
ikpt
! ..
! .. Local Scalars ..
REAL
q1
,
zsl1
,
zsl2
,
qi
,
volsli
,
volintsli
...
...
@@ -105,7 +105,7 @@ CONTAINS
DO
j
=
1
,
stars
%
ng3
qi
=
qi
+
z_z
(
j
)
*
stfunint
(
j
,
i
)
ENDDO
slab
%
qintsl
(
i
,
n
)
=
qi
slab
%
qintsl
(
i
,
n
,
ikpt
,
isp
)
=
qi
ENDDO
! over vacuum%layers
ENDDO
! over states
...
...
cdn/q_mt_sl.f90
View file @
bfbfae41
...
...
@@ -134,7 +134,7 @@ CONTAINS
DO
ntyp
=
1
,
atoms
%
ntype
qq
=
qq
+
qmttot
(
ntyp
,
i
)
*
slab
%
nmtsl
(
ntyp
,
nl
)
ENDDO
slab
%
qmtsl
(
nl
,
i
)
=
qq
slab
%
qmtsl
(
nl
,
i
,
ikpt
,
jsp
)
=
qq
ENDDO
ENDDO
! DO ntyp = 1,ntype
...
...
dos/Ek_write_sl.f90
View file @
bfbfae41
...
...
@@ -32,7 +32,7 @@ CONTAINS
INTEGER
norb
(
23
),
iqsl
(
slab
%
nsld
),
iqvacpc
(
2
)
REAL
qvact
(
2
)
REAL
,
ALLOCATABLE
::
eig
(:),
orbcomp
(:,:,:,:,:)
REAL
,
ALLOCATABLE
::
q
intsl
(:,:,:,:),
qmtsl
(:,:,:,:),
q
mtp
(:,:,:,:)
REAL
,
ALLOCATABLE
::
qmtp
(:,:,:,:)
CHARACTER
(
len
=
2
)
::
chntype
CHARACTER
(
len
=
99
)
::
chform
! ..
...
...
@@ -40,8 +40,7 @@ CONTAINS
CALL
juDFT_error
(
"nsl.GT.nsld"
,
calledby
=
"Ek_write_sl"
)
ENDIF
ALLOCATE
(
eig
(
dimension
%
neigd
),
orbcomp
(
dimension
%
neigd
,
23
,
atoms
%
nat
,
kpts
%
nkpt
,
dimension
%
jspd
))
ALLOCATE
(
qintsl
(
slab
%
nsld
,
dimension
%
neigd
,
kpts
%
nkpt
,
dimension
%
jspd
))
ALLOCATE
(
qmtsl
(
slab
%
nsld
,
dimension
%
neigd
,
kpts
%
nkpt
,
dimension
%
jspd
),
qmtp
(
dimension
%
neigd
,
atoms
%
nat
,
kpts
%
nkpt
,
dimension
%
jspd
))
ALLOCATE
(
qmtp
(
dimension
%
neigd
,
atoms
%
nat
,
kpts
%
nkpt
,
dimension
%
jspd
))
!
! ---> open files for a bandstucture with an orbital composition
! ---> in the case of the film geometry
...
...
@@ -77,8 +76,7 @@ CONTAINS
DO
ikpt
=
1
,
kpts
%
nkpt
!
call
read_eig
(
eig_id
,
ikpt
,
kspin
,
neig
=
nbands
,
eig
=
eig
)
call
read_dos
(
eig_id
,
ikpt
,
kspin
,&
qintsl
=
qintsl
(:,:,
ikpt
,
kspin
),
qmtsl
=
qmtsl
(:,:,
ikpt
,
kspin
),
qmtp
=
qmtp
(:,:,
ikpt
,
kspin
),
orbcomp
=
orbcomp
(:,:,:,
ikpt
,
kspin
))
call
read_dos
(
eig_id
,
ikpt
,
kspin
,
qmtp
=
qmtp
(:,:,
ikpt
,
kspin
),
orbcomp
=
orbcomp
(:,:,:,
ikpt
,
kspin
))
! write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
!
WRITE
(
130
,
FMT
=
8000
)
(
kpts
%
bk
(
i
,
ikpt
),
i
=
1
,
3
)
...
...
@@ -92,11 +90,9 @@ CONTAINS
IF
(
sym
%
invs
.OR.
sym
%
zrfs
)
qvact
(
2
)
=
qvact
(
1
)
iqvacpc
(:)
=
nint
(
qvact
(:)
*
100.0
)
DO
j
=
1
,
slab
%
nsl
iqsl
(
j
)
=
nint
(
(
qintsl
(
j
,
iband
,
ikpt
,
kspin
)
+
&
&
qmtsl
(
j
,
iband
,
ikpt
,
kspin
)
)
*
100.0
)
iqsl
(
j
)
=
nint
((
slab
%
qintsl
(
j
,
iband
,
ikpt
,
kspin
)
+
slab
%
qmtsl
(
j
,
iband
,
ikpt
,
kspin
))
*
100.0
)
ENDDO
WRITE
(
130
,
FMT
=
chform
)
iband
,
eig
(
iband
),
iqvacpc
(
2
),&
&
(
iqsl
(
l
),
l
=
1
,
slab
%
nsl
),
iqvacpc
(
1
)
WRITE
(
130
,
FMT
=
chform
)
iband
,
eig
(
iband
),
iqvacpc
(
2
),(
iqsl
(
l
),
l
=
1
,
slab
%
nsl
),
iqvacpc
(
1
)
WRITE
(
130
,
FMT
=
9
)
WRITE
(
130
,
FMT
=
8
)
WRITE
(
130
,
FMT
=
9
)
...
...
@@ -108,12 +104,9 @@ CONTAINS
na
=
slab
%
nslat
(
mt
,
n
)
IF
(
na
.EQ.
1
)
THEN
DO
j
=
1
,
23
norb
(
j
)
=
&
&
nint
(
orbcomp
(
iband
,
j
,
mt
,
ikpt
,
kspin
)
)
norb
(
j
)
=
nint
(
orbcomp
(
iband
,
j
,
mt
,
ikpt
,
kspin
)
)
ENDDO
WRITE
(
130
,
FMT
=
5
)
n
,
it
,
m
,&
&
(
norb
(
l
),
l
=
1
,
23
),&
&
qmtp
(
iband
,
mt
,
ikpt
,
kspin
)
WRITE
(
130
,
FMT
=
5
)
n
,
it
,
m
,(
norb
(
l
),
l
=
1
,
23
),
qmtp
(
iband
,
mt
,
ikpt
,
kspin
)
ENDIF
ENDDO
enddo
...
...
@@ -133,7 +126,7 @@ CONTAINS
&
7
(
1x
,
i3
,
1x
),
'|'
,
7
(
1x
,
i3
,
1x
),
'|'
,
f6.1
,
'|'
)
9
FORMAT
(
133
(
'-'
))
!
DEALLOCATE
(
eig
,
orbcomp
,
q
intsl
,
qmtsl
,
q
mtp
)
DEALLOCATE
(
eig
,
orbcomp
,
qmtp
)
END
SUBROUTINE
Ek_write_sl
END
MODULE
m_Ekwritesl
dos/doswrite.f90
View file @
bfbfae41
...
...
@@ -12,7 +12,7 @@ MODULE m_doswrite
!
CONTAINS
SUBROUTINE
doswrite
(
eig_id
,
DIMENSION
,
kpts
,
atoms
,
vacuum
,
input
,
banddos
,&
sliceplot
,
noco
,
sym
,
cell
,
dos
,
mcd
,
results
,
nsld
,
oneD
)
sliceplot
,
noco
,
sym
,
cell
,
dos
,
mcd
,
results
,
slab
,
oneD
)
USE
m_evaldos
USE
m_cdninf
USE
m_types
...
...
@@ -28,6 +28,7 @@ CONTAINS
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_slab
),
INTENT
(
IN
)
::
slab
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_mcd
),
INTENT
(
IN
)
::
mcd
...
...
@@ -35,7 +36,7 @@ CONTAINS
! .. Scalar Arguments ..
INTEGER
,
PARAMETER
::
n2max
=
13
INTEGER
,
INTENT
(
IN
)
::
nsld
,
eig_id
INTEGER
,
INTENT
(
IN
)
::
eig_id
! locals
REAL
::
wk
,
bkpt
(
3
)
...
...
@@ -103,7 +104,7 @@ CONTAINS
! write DOS/VACDOS
IF
(
banddos
%
dos
.AND.
(
banddos
%
ndir
.LT.
0
))
THEN
CALL
evaldos
(
eig_id
,
input
,
banddos
,
vacuum
,
kpts
,
atoms
,
sym
,
noco
,
oneD
,
cell
,
results
,
dos
,&
DIMENSION
,
results
%
ef
,
results
%
bandgap
,
banddos
%
l_mcd
,
mcd
,
nsld
)
DIMENSION
,
results
%
ef
,
results
%
bandgap
,
banddos
%
l_mcd
,
mcd
,
slab
)
END
IF
! Now write to vacwave if nstm=3
...
...
dos/evaldos.f90
View file @
bfbfae41
MODULE
m_evaldos
CONTAINS
SUBROUTINE
evaldos
(
eig_id
,
input
,
banddos
,
vacuum
,
kpts
,
atoms
,
sym
,
noco
,
oneD
,
cell
,
results
,
dos
,&
dimension
,
efermiarg
,
bandgap
,
l_mcd
,
mcd
,
nsld
)
dimension
,
efermiarg
,
bandgap
,
l_mcd
,
mcd
,
slab
)
!----------------------------------------------------------------------
!
! vk: k-vectors
...
...
@@ -42,10 +42,10 @@
TYPE
(
t_results
),
INTENT
(
IN
)
::
results
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_mcd
),
INTENT
(
IN
)
::
mcd
TYPE
(
t_slab
),
INTENT
(
IN
)
::
slab
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
INTEGER
,
INTENT
(
IN
)
::
nsld
REAL
,
INTENT
(
IN
)
::
efermiarg
,
bandgap
LOGICAL
,
INTENT
(
IN
)
::
l_mcd
...
...
@@ -63,7 +63,7 @@
REAL
e_grid
(
ned
+1
),
spect
(
ned
,
3
*
atoms
%
ntype
),
ferwe
(
dimension
%
neigd
,
kpts
%
nkpt
)
REAL
,
ALLOCATABLE
::
qal
(:,:,:),
qval
(:,:,:),
qlay
(:,:,:),
g
(:,:)
REAL
,
ALLOCATABLE
::
mcd_local
(:,:,:),
orbcomp
(:,:,:),
qmtp
(:,:)
REAL
,
ALLOCATABLE
::
q
intsl
(:,:),
qmtsl
(:,:),
q
vac
(:,:)
REAL
,
ALLOCATABLE
::
qvac
(:,:)
CHARACTER
(
len
=
2
)
::
spin12
(
2
),
ch_mcd
(
3
)
CHARACTER
(
len
=
8
)
::
chntype
*
2
,
chform
*
19
DATA
spin12
/
'.1'
,
'.2'
/
...
...
@@ -73,7 +73,7 @@
qdim
=
lmax
*
atoms
%
ntype
+3
l_orbcomp
=
banddos
%
l_orb
IF
(
banddos
%
ndir
.EQ.
-3
)
THEN
qdim
=
2
*
nsld
qdim
=
2
*
slab
%
nsld
n_orb
=
0
IF
(
banddos
%
l_orb
)
THEN
n_orb
=
banddos
%
orbCompAtom
...
...
@@ -156,9 +156,9 @@
! read data from file!
ntb
=
max
(
ntb
,
results
%
neig
(
k
,
jspin
))
ALLOCATE
(
orbcomp
(
dimension
%
neigd
,
23
,
atoms
%
nat
)
,
qintsl
(
nsld
,
dimension
%
neigd
)
)
ALLOCATE
(
qmt
sl
(
nsld
,
dimension
%
neigd
),
qmt
p
(
dimension
%
neigd
,
atoms
%
nat
))
CALL
read_dos
(
eig_id
,
k
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
ALLOCATE
(
orbcomp
(
dimension
%
neigd
,
23
,
atoms
%
nat
))
ALLOCATE
(
qmtp
(
dimension
%
neigd
,
atoms
%
nat
))
CALL
read_dos
(
eig_id
,
k
,
jspin
,
qmtp
,
orbcomp
)
IF
(
l_mcd
)
mcd_local
(:,:,
k
)
=
RESHAPE
(
mcd
%
mcd
(:,
1
:
ncored
,:,
k
,
jspin
),(/
3
*
atoms
%
ntype
*
ncored
,
dimension
%
neigd
/))
IF
(
.NOT.
l_orbcomp
)
THEN
qal
(
1
:
lmax
*
atoms
%
ntype
,:,
k
)
=
reshape
(
dos
%
qal
(
0
:,:,:,
k
,
jspin
),(/
lmax
*
atoms
%
ntype
,
size
(
dos
%
qal
,
3
)/))
...
...
@@ -167,8 +167,8 @@
qal
(
lmax
*
atoms
%
ntype
+1
,:,
k
)
=
dos
%
qis
(:,
k
,
jspin
)
! interstitial
ELSE
IF
(
n_orb
==
0
)
THEN
qal
(
1
:
nsld
,:,
k
)
=
qintsl
(:,:
)
qal
(
nsld
+1
:
2
*
nsld
,:,
k
)
=
qmtsl
(:,:
)
qal
(
1
:
slab
%
nsld
,:,
k
)
=
slab
%
qintsl
(:,:,
k
,
jspin
)
qal
(
slab
%
nsld
+1
:
2
*
slab
%
nsld
,:,
k
)
=
slab
%
qmtsl
(:,:,
k
,
jspin
)
ELSE
DO
i
=
1
,
23
DO
l
=
1
,
results
%
neig
(
k
,
jspin
)
...
...
@@ -180,7 +180,7 @@
END
DO
END
IF
END
IF
DEALLOCATE
(
orbcomp
,
q
intsl
,
qmtsl
,
q
mtp
)
DEALLOCATE
(
orbcomp
,
qmtp
)
!
! set vacuum partial charge zero, if bulk calculation
! otherwise, write vacuum charge in correct arrays
...
...
@@ -356,8 +356,8 @@
ENDDO
ENDDO
ELSEIF
(
n_orb
==
0
)
THEN
DO
l
=
1
,
nsld
nl
=
nsld
+
l
DO
l
=
1
,
slab
%
nsld
nl
=
slab
%
nsld
+
l
DO
i
=
1
,
ned
gpart
(
i
,
l
)
=
g
(
i
,
l
)
+
g
(
i
,
nl
)
ENDDO
...
...
@@ -384,10 +384,10 @@
g
(
i
,
lmax
*
atoms
%
ntype
+2
),
g
(
i
,
lmax
*
atoms
%
ntype
+3
),
(
gpart
(
i
,
l
),
l
=
1
,
atoms
%
ntype
)
ENDIF
ELSEIF
(
n_orb
==
0
)
THEN
DO
nl
=
1
,
nsld
DO
nl
=
1
,
slab
%
nsld
totdos
=
totdos
+
gpart
(
i
,
nl
)
ENDDO
WRITE
(
18
,
99001
)
e
(
i
),
totdos
,(
gpart
(
i
,
nl
),
nl
=
1
,
nsld
),
(
g
(
i
,
l
),
l
=
1
,
2
*
nsld
)
WRITE
(
18
,
99001
)
e
(
i
),
totdos
,(
gpart
(
i
,
nl
),
nl
=
1
,
slab
%
nsld
),
(
g
(
i
,
l
),
l
=
1
,
2
*
slab
%
nsld
)
ELSE
DO
nl
=
1
,
23
totdos
=
totdos
+
g
(
i
,
nl
)
...
...
io/eig66_da.F90
View file @
bfbfae41
...
...
@@ -266,38 +266,35 @@ CONTAINS
END
SUBROUTINE
write_eig
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
IN
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_DA
),
POINTER
::
d
INTEGER
::
nrec
CALL
priv_find_data
(
id
,
d
)
nrec
=
nk
+
(
jspin
-1
)
*
d
%
nkpts
IF
(
d
%
l_orb
.AND.
PRESENT
(
qmtsl
)
)
THEN
IF
(
d
%
l_orb
)
THEN
IF
(
d
%
l_mcd
)
CPP_error
(
"mcd & orbital decomposition not implemented in IO"
)
WRITE
(
d
%
file_io_id_dos
,
REC
=
nrec
)
qintsl
,
qmtsl
,
qmtp
,
orbcomp
ELSEIF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
THEN
WRITE
(
d
%
file_io_id_dos
,
REC
=
nrec
)
mcd
WRITE
(
d
%
file_io_id_dos
,
REC
=
nrec
)
qmtp
,
orbcomp
END
IF
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
q
intsl
(:,:),
qmtsl
(:,:),
q
mtp
(:,:),
orbcomp
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_DA
),
POINTER
::
d
INTEGER
::
nrec
CALL
priv_find_data
(
id
,
d
)
nrec
=
nk
+
(
jspin
-1
)
*
d
%
nkpts
IF
(
d
%
l_orb
.AND.
PRESENT
(
qmtsl
)
)
THEN
IF
(
d
%
l_orb
)
THEN
IF
(
d
%
l_mcd
)
CPP_error
(
"mcd & orbital decomposition not implemented in IO"
)
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
qmtp
,
orbcomp
END
IF
END
SUBROUTINE
read_dos
...
...
io/eig66_hdf.F90
View file @
bfbfae41
...
...
@@ -294,16 +294,14 @@ CONTAINS
END
SUBROUTINE
priv_r_vec
#endif
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_HDF
),
POINTER
::
d
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_HDF
),
POINTER
::
d
CALL
priv_find_data
(
id
,
d
)
#ifdef CPP_HDF
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
CALL
io_read_real2
(
d
%
qintslsetid
,(/
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qintsl
,
1
),
SIZE
(
qintsl
,
2
),
1
,
1
/),
qintsl
)
CALL
io_read_real2
(
d
%
qmtslsetid
,(/
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qmtsl
,
1
),
SIZE
(
qmtsl
,
2
),
1
,
1
/),
qmtsl
)
IF
(
d
%
l_orb
)
THEN
CALL
io_read_real2
(
d
%
qmtpsetid
,(/
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qmtp
,
1
),
SIZE
(
qmtp
,
2
),
1
,
1
/),
qmtp
)
CALL
io_read_real3
(
d
%
orbcompsetid
,(/
1
,
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
orbcomp
,
1
),
23
,
SIZE
(
orbcomp
,
3
),
1
,
1
/),
orbcomp
)
ENDIF
...
...
io/eig66_io.F90
View file @
bfbfae41
...
...
@@ -181,13 +181,13 @@ CONTAINS
CALL
timestart
(
"IO (dos-write)"
)
SELECT
CASE
(
eig66_data_mode
(
id
))
CASE
(
da_mode
)
CALL
write_dos_DA
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_DA
(
id
,
nk
,
jspin
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
hdf_mode
)
CALL
write_dos_HDF
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_HDF
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
(:,:,
nk
,
jspin
),
slab
%
qmtsl
(:,:,
nk
,
jspin
)
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
mem_mode
)
CALL
write_dos_Mem
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_Mem
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
(:,:,
nk
,
jspin
),
slab
%
qmtsl
(:,:,
nk
,
jspin
)
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
MPI_mode
)
CALL
write_dos_MPI
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_MPI
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
(:,:,
nk
,
jspin
),
slab
%
qmtsl
(:,:,
nk
,
jspin
)
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
-1
)
CALL
juDFT_error
(
"Could not write DOS to eig-file before opening"
,
calledby
=
"eig66_io"
)
END
SELECT
...
...
@@ -195,24 +195,24 @@ CONTAINS
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
USE
m_eig66_hdf
,
ONLY
:
read_dos_hdf
=>
read_dos
USE
m_eig66_DA
,
ONLY
:
read_dos_DA
=>
read_dos
USE
m_eig66_mem
,
ONLY
:
read_dos_MEM
=>
read_dos
USE
m_eig66_MPI
,
ONLY
:
read_dos_MPI
=>
read_dos
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qmtp
(:,:),
orbcomp
(:,:,:)
CALL
timestart
(
"IO (dos-read)"
)
SELECT
CASE
(
eig66_data_mode
(
id
))
CASE
(
da_mode
)
CALL
read_dos_DA
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
CALL
read_dos_DA
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
CASE
(
hdf_mode
)
CALL
read_dos_HDF
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
CALL
read_dos_HDF
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
CASE
(
mem_mode
)
CALL
read_dos_Mem
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
CALL
read_dos_Mem
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
CASE
(
MPI_mode
)
CALL
read_dos_MPI
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
CALL
read_dos_MPI
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
CASE
(
-1
)
CALL
juDFT_error
(
"Could not DOS from read eig-file before opening"
,
calledby
=
"eig66_io"
)
END
SELECT
...
...
io/eig66_mem.F90
View file @
bfbfae41
...
...
@@ -172,10 +172,10 @@ CONTAINS
ENDIF
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
q
intsl
(:,:),
qmtsl
(:,:),
q
mtp
(:,:),
orbcomp
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qmtp
(:,:),
orbcomp
(:,:,:)
INTEGER
::
nrec
TYPE
(
t_data_mem
),
POINTER
::
d
...
...
@@ -183,9 +183,7 @@ CONTAINS
nrec
=
nk
+
(
jspin
-1
)
*
d
%
nkpts
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
qintsl
=
d
%
qintsl
(:,:,
nrec
)
qmtsl
=
d
%
qmtsl
(:,:,
nrec
)
IF
(
d
%
l_orb
)
THEN
qmtp
=
d
%
qmtp
(:,:,
nrec
)
orbcomp
=
d
%
orbcomp
(:,:,:,
nrec
)
ENDIF
...
...
io/eig66_mpi.F90
View file @
bfbfae41
...
...
@@ -525,10 +525,10 @@ CONTAINS
#endif
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
q
intsl
,
qmtsl
,
q
mtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
out
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
REAL
,
INTENT
(
out
),
OPTIONAL
::
qmtp
(:,:),
orbcomp
(:,:,:)
#ifdef CPP_MPI
TYPE
(
t_data_MPI
),
POINTER
::
d
INTEGER
::
pe
,
slot
...
...
@@ -537,9 +537,7 @@ CONTAINS
pe
=
d
%
pe_basis
(
nk
,
jspin
)
slot
=
d
%
slot_basis
(
nk
,
jspin
)
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qintsl
),
d
%
qintsl_handle
,
rdata
=
qintsl
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qmtsl
),
d
%
qmtsl_handle
,
rdata
=
qmtsl
)
IF
(
d
%
l_orb
)
THEN
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qmtp
),
d
%
qmtp_handle
,
rdata
=
qmtp
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
orbcomp
),
d
%
orbcomp_handle
,
rdata
=
orbcomp
)
ENDIF
...
...
main/cdngen.F90
View file @
bfbfae41
...
...
@@ -102,7 +102,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF
(
mpi
%
irank
.EQ.
0
)
THEN
IF
(
banddos
%
dos
.or.
banddos
%
vacdos
.or.
input
%
cdinf
)
THEN
CALL
timestart
(
"cdngen: dos"
)
CALL
doswrite
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
banddos
,
sliceplot
,
noco
,
sym
,
cell
,
dos
,
mcd
,
results
,
slab
%
nsld
,
oneD
)
CALL
doswrite
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
banddos
,
sliceplot
,
noco
,
sym
,
cell
,
dos
,
mcd
,
results
,
slab
,
oneD
)
IF
(
banddos
%
dos
.AND.
(
banddos
%
ndir
.EQ.
-3
))
THEN
CALL
Ek_write_sl
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
jspmax
,
sym
,
cell
,
dos
,
slab
)
END
IF
...
...
mpi/mpi_col_den.F90
View file @
bfbfae41
...
...
@@ -9,7 +9,7 @@ MODULE m_mpi_col_den
! collect all data calculated in cdnval on different pe's on pe 0
!
CONTAINS
SUBROUTINE
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
jspin
,
regCharges
,
dos
,
mcd
,&
SUBROUTINE
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
jspin
,
regCharges
,
dos
,
mcd
,
slab
,
&
results
,
denCoeffs
,
orb
,
denCoeffsOffdiag
,
den
,
n_mmp
)
#include"cpp_double.h"
...
...
@@ -20,12 +20,12 @@ CONTAINS
TYPE
(
t_results
),
INTENT
(
INOUT
)::
results
TYPE
(
t_mpi
),
INTENT
(
IN
)
::
mpi
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
den
INCLUDE
'mpif.h'
...
...
@@ -41,6 +41,7 @@ CONTAINS
TYPE
(
t_regionCharges
),
INTENT
(
INOUT
)
::
regCharges
TYPE
(
t_dos
),
INTENT
(
INOUT
)
::
dos
TYPE
(
t_mcd
),
INTENT
(
INOUT
)
::
mcd
TYPE
(
t_slab
),
INTENT
(
INOUT
)
::
slab
! ..
! .. Local Scalars ..
INTEGER
::
n
,
i
...
...
@@ -181,6 +182,19 @@ CONTAINS
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
mcd
%
mcd
(:,:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
! Collect slab - qintsl and qmtsl
n
=
SIZE
(
slab
%
qintsl
,
1
)
*
SIZE
(
slab
%
qintsl
,
2
)
*
SIZE
(
slab
%
qintsl
,
3
)
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
slab
%
qintsl
(:,:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
slab
%
qintsl
(:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
n
=
SIZE
(
slab
%
qmtsl
,
1
)
*
SIZE
(
slab
%
qmtsl
,
2
)
*
SIZE
(
slab
%
qmtsl
,
3
)
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
slab
%
qmtsl
(:,:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
slab
%
qmtsl
(:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
! -> Collect force
IF
(
input
%
l_f
)
THEN
n
=
3
*
atoms
%
ntype
...
...
types/types_cdnval.f90
View file @
bfbfae41
...
...
@@ -68,8 +68,8 @@ PRIVATE
REAL
,
ALLOCATABLE
::
zsl
(:,:)
REAL
,
ALLOCATABLE
::
volsl
(:)
REAL
,
ALLOCATABLE
::
volintsl
(:)
REAL
,
ALLOCATABLE
::
qintsl
(:,:)
REAL
,
ALLOCATABLE
::
qmtsl
(:,:)
REAL
,
ALLOCATABLE
::
qintsl
(:,:
,:,:
)
REAL
,
ALLOCATABLE
::
qmtsl
(:,:
,:,:
)
CONTAINS
PROCEDURE
,
PASS
::
init
=>
slab_init
...
...
@@ -278,9 +278,10 @@ SUBROUTINE denCoeffs_init(thisDenCoeffs, atoms, sphhar, jsp_start, jsp_end)
END
SUBROUTINE
denCoeffs_init
SUBROUTINE
slab_init
(
thisSlab
,
banddos
,
dimension
,
atoms
,
cell
)
SUBROUTINE
slab_init
(
thisSlab
,
banddos
,
dimension
,
atoms
,
cell
,
input
,
kpts
)
USE
m_types_setup
USE
m_types_kpts
USE
m_slabdim
USE
m_slabgeom
...
...
@@ -291,6 +292,8 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
INTEGER
::
nsld
...
...
@@ -311,8 +314,8 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
ALLOCATE
(
thisSlab
%
zsl
(
2
,
nsld
))
ALLOCATE
(
thisSlab
%
volsl
(
nsld
))
ALLOCATE
(
thisSlab
%
volintsl
(
nsld
))
ALLOCATE
(
thisSlab
%
qintsl
(
nsld
,
dimension
%
neigd
))
ALLOCATE
(
thisSlab
%
qmtsl
(
nsld
,
dimension
%
neigd
))
ALLOCATE
(
thisSlab
%
qintsl
(
nsld
,
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisSlab
%
qmtsl
(
nsld
,
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
))
CALL
slabgeom
(
atoms
,
cell
,
nsld
,
thisSlab
%
nsl
,
thisSlab
%
zsl
,
thisSlab
%
nmtsl
,&
thisSlab
%
nslat
,
thisSlab
%
volsl
,
thisSlab
%
volintsl
)
ELSE
...
...
@@ -321,8 +324,8 @@ SUBROUTINE slab_init(thisSlab,banddos,dimension,atoms,cell)
ALLOCATE
(
thisSlab
%
zsl
(
1
,
1
))
ALLOCATE
(
thisSlab
%
volsl
(
1
))
ALLOCATE
(
thisSlab
%
volintsl
(
1
))
ALLOCATE
(
thisSlab
%
qintsl
(
1
,
1
))
ALLOCATE
(
thisSlab
%
qmtsl
(
1
,
1
))
ALLOCATE
(
thisSlab
%
qintsl
(
1
,
1
,
1
,
input
%
jspins
))
ALLOCATE
(
thisSlab
%
qmtsl
(
1
,
1
,
1
,
input
%
jspins
))
END
IF
thisSlab
%
nsld
=
nsld
...
...
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