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
53
Issues
53
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
cced8df0
Commit
cced8df0
authored
Apr 27, 2018
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove requirement for read_dos, write_dos subroutines (part 2)
parent
b4f9dbd5
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
56 additions
and
167 deletions
+56
-167
cdn/cdnval.F90
cdn/cdnval.F90
+1
-1
dos/Ek_write_sl.f90
dos/Ek_write_sl.f90
+7
-12
dos/doswrite.f90
dos/doswrite.f90
+2
-12
dos/evaldos.f90
dos/evaldos.f90
+23
-30
io/eig66_da.F90
io/eig66_da.F90
+6
-16
io/eig66_hdf.F90
io/eig66_hdf.F90
+2
-28
io/eig66_io.F90
io/eig66_io.F90
+10
-23
io/eig66_mem.F90
io/eig66_mem.F90
+2
-22
io/eig66_mpi.F90
io/eig66_mpi.F90
+2
-22
main/cdngen.F90
main/cdngen.F90
+1
-1
No files found.
cdn/cdnval.F90
View file @
cced8df0
...
...
@@ -271,7 +271,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
! since z is no longer an argument of cdninf sympsi has to be called here!
IF
(
banddos
%
ndir
.GT.
0
)
CALL
sympsi
(
lapw
,
jspin
,
sym
,
dimension
,
nbands
,
cell
,
eig
,
noco
,
dos
%
ksym
(:,
ikpt
,
jspin
),
dos
%
jsym
(:,
ikpt
,
jspin
),
zMat
)
CALL
write_dos
(
eig_id
,
ikpt
,
jspin
,
dos
,
slab
,
orbcomp
,
dos
%
ksym
(:,
ikpt
,
jspin
),
dos
%
jsym
(:,
ikpt
,
jspin
)
,
mcd
%
mcd
)
CALL
write_dos
(
eig_id
,
ikpt
,
jspin
,
slab
,
orbcomp
,
mcd
%
mcd
)
END
IF
END
DO
! end of k-point loop
...
...
dos/Ek_write_sl.f90
View file @
cced8df0
MODULE
m_Ekwritesl
use
m_juDFT
CONTAINS
SUBROUTINE
Ek_write_sl
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
jspin
,
sym
,
cell
,
slab
)
SUBROUTINE
Ek_write_sl
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
jspin
,
sym
,
cell
,
dos
,
slab
)
!-----------------------------------------------------------------
!-- now write E(k) for all kpts if on T3E
!-- now read data from tmp_dos and write of E(k) in ek_orbcomp
...
...
@@ -14,6 +14,7 @@ CONTAINS
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_slab
),
INTENT
(
IN
)
::
slab
...
...
@@ -30,10 +31,7 @@ CONTAINS
! .. Local Arrays
INTEGER
norb
(
23
),
iqsl
(
slab
%
nsld
),
iqvacpc
(
2
)
REAL
qvact
(
2
)
REAL
,
ALLOCATABLE
::
eig
(:),
qvac
(:,:,:,:),
orbcomp
(:,:,:,:,:)
REAL
,
ALLOCATABLE
::
qal
(:,:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
ALLOCATABLE
::
qstars
(:,:,:,:)
INTEGER
,
ALLOCATABLE
::
ksym
(:),
jsym
(:)
REAL
,
ALLOCATABLE
::
eig
(:),
orbcomp
(:,:,:,:,:)
REAL
,
ALLOCATABLE
::
qintsl
(:,:,:,:),
qmtsl
(:,:,:,:),
qmtp
(:,:,:,:)
CHARACTER
(
len
=
2
)
::
chntype
CHARACTER
(
len
=
99
)
::
chform
...
...
@@ -42,11 +40,8 @@ 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
(
q
vac
(
dimension
%
neigd
,
2
,
kpts
%
nkpt
,
dimension
%
jspd
),
q
intsl
(
slab
%
nsld
,
dimension
%
neigd
,
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
(
qal
(
4
,
atoms
%
ntype
,
dimension
%
neigd
),
qis
(
dimension
%
neigd
),
qvlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
))
ALLOCATE
(
qstars
(
vacuum
%
nstars
,
dimension
%
neigd
,
vacuum
%
layerd
,
2
))
ALLOCATE
(
ksym
(
dimension
%
neigd
),
jsym
(
dimension
%
neigd
))
!
! ---> open files for a bandstucture with an orbital composition
! ---> in the case of the film geometry
...
...
@@ -82,7 +77,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
,
qal
,
qvac
(:,:,
ikpt
,
kspin
),
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
&
call
read_dos
(
eig_id
,
ikpt
,
kspin
,&
qintsl
=
qintsl
(:,:,
ikpt
,
kspin
),
qmtsl
=
qmtsl
(:,:,
ikpt
,
kspin
),
qmtp
=
qmtp
(:,:,
ikpt
,
kspin
),
orbcomp
=
orbcomp
(:,:,:,
ikpt
,
kspin
))
! write(*,*) kspin,nkpt,qmtp(1,:,ikpt,kspin)
!
...
...
@@ -92,7 +87,7 @@ CONTAINS
DO
iband
=
1
,
nbands
qvact
=
0.0
DO
ivac
=
1
,
vacuum
%
nvac
qvact
(
ivac
)
=
qvac
(
iband
,
ivac
,
ikpt
,
kspin
)
qvact
(
ivac
)
=
dos
%
qvac
(
iband
,
ivac
,
ikpt
,
kspin
)
ENDDO
IF
(
sym
%
invs
.OR.
sym
%
zrfs
)
qvact
(
2
)
=
qvact
(
1
)
iqvacpc
(:)
=
nint
(
qvact
(:)
*
100.0
)
...
...
@@ -138,7 +133,7 @@ CONTAINS
&
7
(
1x
,
i3
,
1x
),
'|'
,
7
(
1x
,
i3
,
1x
),
'|'
,
f6.1
,
'|'
)
9
FORMAT
(
133
(
'-'
))
!
DEALLOCATE
(
eig
,
qvac
,
orbcomp
,
qintsl
,
qmtsl
,
qmtp
)
DEALLOCATE
(
eig
,
orbcomp
,
qintsl
,
qmtsl
,
qmtp
)
END
SUBROUTINE
Ek_write_sl
END
MODULE
m_Ekwritesl
dos/doswrite.f90
View file @
cced8df0
...
...
@@ -28,7 +28,7 @@ CONTAINS
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_mcd
),
INTENT
(
IN
)
::
mcd
...
...
@@ -39,14 +39,8 @@ CONTAINS
INTEGER
,
INTENT
(
IN
)
::
nsld
,
eig_id
! locals
INTEGER
::
jsym
(
DIMENSION
%
neigd
),
ksym
(
DIMENSION
%
neigd
)
REAL
::
wk
,
bkpt
(
3
)
REAL
::
eig
(
DIMENSION
%
neigd
)
REAL
::
qal
(
0
:
3
,
atoms
%
ntype
,
DIMENSION
%
neigd
,
DIMENSION
%
jspd
)
REAL
::
qis
(
DIMENSION
%
neigd
,
kpts
%
nkpt
,
DIMENSION
%
jspd
)
REAL
::
qvac
(
DIMENSION
%
neigd
,
2
,
kpts
%
nkpt
,
DIMENSION
%
jspd
)
REAL
::
qvlay
(
DIMENSION
%
neigd
,
vacuum
%
layerd
,
2
)
COMPLEX
::
qstars
(
vacuum
%
nstars
,
DIMENSION
%
neigd
,
vacuum
%
layerd
,
2
)
REAL
::
eig
(
DIMENSION
%
neigd
)
INTEGER
::
ne
,
ikpt
,
kspin
,
j
,
i
,
n
COMPLEX
,
ALLOCATABLE
::
ac
(:,:),
bc
(:,:)
...
...
@@ -92,10 +86,6 @@ CONTAINS
ENDIF
DO
ikpt
=
1
,
kpts
%
nkpt
! call read_eig(eig_id,ikpt,kspin,neig=ne,eig=eig)
! call read_dos(eig_id,ikpt,kspin,qal(:,:,:,kspin),qvac(:,:,ikpt,kspin),&
! qis(:,ikpt,kspin),qvlay(:,:,:),qstars,ksym,jsym)
CALL
cdninf
(
input
,
sym
,
noco
,
kspin
,
atoms
,
vacuum
,
sliceplot
,
banddos
,
ikpt
,
kpts
%
bk
(:,
ikpt
),&
kpts
%
wtkpt
(
ikpt
),
cell
,
kpts
,
results
%
neig
(
ikpt
,
kspin
),
results
%
eig
(:,
ikpt
,
kspin
),
dos
%
qal
(
0
:,:,:,
ikpt
,
kspin
),
dos
%
qis
,
dos
%
qvac
,&
dos
%
qvlay
(:,:,:,
ikpt
,
kspin
),
dos
%
qstars
(:,:,:,:,
ikpt
,
kspin
),
dos
%
ksym
(:,
ikpt
,
kspin
),
dos
%
jsym
(:,
ikpt
,
kspin
))
...
...
dos/evaldos.f90
View file @
cced8df0
...
...
@@ -60,15 +60,13 @@
REAL
e_up
,
e_lo
,
e_test1
,
e_test2
,
fac
,
sumwei
,
dk
,
eFermiCorrection
LOGICAL
l_tria
,
l_orbcomp
,
l_error
INTEGER
itria
(
3
,
2
*
kpts
%
nkpt
),
nevk
(
kpts
%
nkpt
),
itetra
(
4
,
6
*
kpts
%
nkpt
)
INTEGER
,
ALLOCATABLE
::
ksym
(:),
jsym
(:)
INTEGER
itria
(
3
,
2
*
kpts
%
nkpt
),
itetra
(
4
,
6
*
kpts
%
nkpt
)
REAL
voltet
(
6
*
kpts
%
nkpt
),
kx
(
kpts
%
nkpt
),
vkr
(
3
,
kpts
%
nkpt
)
REAL
ev
(
dimension
%
neigd
,
kpts
%
nkpt
),
e
(
ned
),
gpart
(
ned
,
atoms
%
ntype
),
atr
(
2
*
kpts
%
nkpt
)
REAL
e_grid
(
ned
+1
),
spect
(
ned
,
3
*
atoms
%
ntype
),
ferwe
(
dimension
%
neigd
,
kpts
%
nkpt
)
REAL
,
ALLOCATABLE
::
qal
(:,:,:),
qval
(:,:,:),
qlay
(:,:,:),
g
(:,:)
,
qal_tmp
(:,:,:),
qis
(:),
qvlay
(:,:,:)
REAL
,
ALLOCATABLE
::
qal
(:,:,:),
qval
(:,:,:),
qlay
(:,:,:),
g
(:,:)
REAL
,
ALLOCATABLE
::
mcd
(:,:,:),
orbcomp
(:,:,:),
qmtp
(:,:)
REAL
,
ALLOCATABLE
::
qintsl
(:,:),
qmtsl
(:,:),
qvac
(:,:)
COMPLEX
,
ALLOCATABLE
::
qstars
(:,:,:,:)
CHARACTER
(
len
=
2
)
::
spin12
(
2
),
ch_mcd
(
3
)
CHARACTER
(
len
=
8
)
::
chntype
*
2
,
chform
*
19
DATA
spin12
/
'.1'
,
'.2'
/
...
...
@@ -88,7 +86,7 @@
ENDIF
ALLOCATE
(
qal
(
qdim
,
dimension
%
neigd
,
kpts
%
nkpt
),&
&
qval
(
vacuum
%
nstars
*
vacuum
%
layers
*
vacuum
%
nvac
,
dimension
%
neigd
,
kpts
%
nkpt
),&
&
qlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
)
,
qstars
(
vacuum
%
nstars
,
dimension
%
neigd
,
vacuum
%
layerd
,
2
)
)
&
qlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
))
IF
(
l_mcd
)
THEN
ALLOCATE
(
mcd
(
3
*
atoms
%
ntype
*
ncored
,
dimension
%
neigd
,
kpts
%
nkpt
)
)
ELSE
...
...
@@ -161,36 +159,31 @@
!
! read data from file!
!
ALLOCATE
(
ksym
(
dimension
%
neigd
),
jsym
(
dimension
%
neigd
)
)
ALLOCATE
(
qal_tmp
(
1
:
lmax
,
atoms
%
ntype
,
dimension
%
neigd
))
ALLOCATE
(
orbcomp
(
dimension
%
neigd
,
23
,
atoms
%
nat
),
qintsl
(
nsld
,
dimension
%
neigd
))
ALLOCATE
(
qmtsl
(
nsld
,
dimension
%
neigd
),
qmtp
(
dimension
%
neigd
,
atoms
%
nat
),
qvac
(
dimension
%
neigd
,
2
))
ALLOCATE
(
qis
(
dimension
%
neigd
),
qvlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
))
CALL
read_eig
(
eig_id
,
k
,
jspin
,
neig
=
nevk
(
k
),
eig
=
ev
(:,
k
))
CALL
read_dos
(
eig_id
,
k
,
jspin
,
qal_tmp
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
ALLOCATE
(
qmtsl
(
nsld
,
dimension
%
neigd
),
qmtp
(
dimension
%
neigd
,
atoms
%
nat
))
CALL
read_dos
(
eig_id
,
k
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IF
(
.NOT.
l_orbcomp
)
THEN
qal
(
1
:
lmax
*
atoms
%
ntype
,:,
k
)
=
reshape
(
qal_tmp
,(/
lmax
*
atoms
%
ntype
,
size
(
qal_tmp
,
3
)/))
qal
(
lmax
*
atoms
%
ntype
+2
,:,
k
)
=
qvac
(:,
1
)
! vacuum 1
qal
(
lmax
*
atoms
%
ntype
+3
,:,
k
)
=
qvac
(:,
2
)
! vacuum 2
qal
(
lmax
*
atoms
%
ntype
+1
,:,
k
)
=
qis
! interstitial
qal
(
1
:
lmax
*
atoms
%
ntype
,:,
k
)
=
reshape
(
dos
%
qal
(
0
:,:,:,
k
,
jspin
),(/
lmax
*
atoms
%
ntype
,
size
(
dos
%
qal
,
3
)/))
qal
(
lmax
*
atoms
%
ntype
+2
,:,
k
)
=
dos
%
qvac
(:,
1
,
k
,
jspin
)
! vacuum 1
qal
(
lmax
*
atoms
%
ntype
+3
,:,
k
)
=
dos
%
qvac
(:,
2
,
k
,
jspin
)
! vacuum 2
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
(:,:)
ELSE
DO
i
=
1
,
23
DO
l
=
1
,
nevk
(
k
)
DO
l
=
1
,
results
%
neig
(
k
,
jspin
)
qal
(
i
,
l
,
k
)
=
orbcomp
(
l
,
i
,
n_orb
)
*
qmtp
(
l
,
n_orb
)/
10000.
END
DO
DO
l
=
nevk
(
k
)
+1
,
dimension
%
neigd
DO
l
=
results
%
neig
(
k
,
jspin
)
+1
,
dimension
%
neigd
qal
(
i
,
l
,
k
)
=
0.0
END
DO
END
DO
END
IF
END
IF
DEALLOCATE
(
ksym
,
jsym
)
DEALLOCATE
(
orbcomp
,
qintsl
,
qmtsl
,
qmtp
,
qvac
,
qis
,
qal_tmp
,
qvlay
)
ntb
=
max
(
ntb
,
nevk
(
k
))
DEALLOCATE
(
orbcomp
,
qintsl
,
qmtsl
,
qmtp
)
ntb
=
max
(
ntb
,
results
%
neig
(
k
,
jspin
))
!
! set vacuum partial charge zero, if bulk calculation
! otherwise, write vacuum charge in correct arrays
...
...
@@ -201,13 +194,13 @@
qal
(
lmax
*
atoms
%
ntype
+3
,
n
,
k
)
=
0.0
ENDDO
ELSEIF
(
banddos
%
vacdos
.and.
input
%
film
)
THEN
DO
i
=
1
,
nevk
(
k
)
DO
i
=
1
,
results
%
neig
(
k
,
jspin
)
DO
v
=
1
,
vacuum
%
nvac
DO
l
=
1
,
vacuum
%
layers
index
=
(
l
-1
)
*
vacuum
%
nstars
+
(
v
-1
)
*
(
vacuum
%
nstars
*
vacuum
%
layers
)
+
1
qval
(
index
,
i
,
k
)
=
qlay
(
i
,
l
,
v
)
DO
s
=
1
,
vacuum
%
nstars
-
1
qval
(
index
+
s
,
i
,
k
)
=
real
(
qstars
(
s
,
i
,
l
,
v
))
qval
(
index
+
s
,
i
,
k
)
=
real
(
dos
%
qstars
(
s
,
i
,
l
,
v
,
k
,
jspin
))
ENDDO
ENDDO
ENDDO
...
...
@@ -236,10 +229,10 @@
!
!---- > convert eigenvalues to ev and shift them by efermi
!
DO
i
=
1
,
nevk
(
k
)
ev
(
i
,
k
)
=
ev
(
i
,
k
)
*
hartree_to_ev_const
-
efermi
DO
i
=
1
,
results
%
neig
(
k
,
jspin
)
ev
(
i
,
k
)
=
results
%
eig
(
i
,
k
,
jspin
)
*
hartree_to_ev_const
-
efermi
ENDDO
DO
i
=
nevk
(
k
)
+
1
,
dimension
%
neigd
DO
i
=
results
%
neig
(
k
,
jspin
)
+
1
,
dimension
%
neigd
ev
(
i
,
k
)
=
9.9e+99
ENDDO
!
...
...
@@ -327,7 +320,7 @@
ELSE
write
(
*
,
*
)
efermi
CALL
tetra_dos
(
lmax
,
atoms
%
ntype
,
dimension
%
neigd
,
ned
,
ntetra
,
kpts
%
nkpt
,&
itetra
,
efermi
,
voltet
,
e
,
nevk
,
ev
,
qal
,
g
)
itetra
,
efermi
,
voltet
,
e
,
results
%
neig
(:,
jspin
)
,
ev
,
qal
,
g
)
IF
(
input
%
jspins
.EQ.
1
)
g
(:,:)
=
2
*
g
(:,:)
ENDIF
ELSE
...
...
@@ -336,10 +329,10 @@
!
IF
(
.not.
l_mcd
)
THEN
CALL
dos_bin
(
input
%
jspins
,
qdim
,
ned
,
emin
,
emax
,
dimension
%
neigd
,
kpts
%
nkpt
,&
nevk
,
kpts
%
wtkpt
(
1
:
kpts
%
nkpt
),
ev
,
qal
,
g
)
results
%
neig
(:,
jspin
)
,
kpts
%
wtkpt
(
1
:
kpts
%
nkpt
),
ev
,
qal
,
g
)
ELSE
CALL
dos_bin
(
input
%
jspins
,
3
*
atoms
%
ntype
*
ncored
,
ned
,
emin
,
emax
,
ntb
,
kpts
%
nkpt
,&
nevk
(
1
:
kpts
%
nkpt
),
kpts
%
wtkpt
(
1
:
kpts
%
nkpt
),
ev
(
1
:
ntb
,
1
:
kpts
%
nkpt
),
mcd
(
1
:
3
*
atoms
%
ntype
*
ncored
,
1
:
ntb
,
1
:
kpts
%
nkpt
),
g
)
results
%
neig
(:,
jspin
),
kpts
%
wtkpt
(
1
:
kpts
%
nkpt
),
ev
(
1
:
ntb
,
1
:
kpts
%
nkpt
),
mcd
(
1
:
3
*
atoms
%
ntype
*
ncored
,
1
:
ntb
,
1
:
kpts
%
nkpt
),
g
)
ENDIF
ENDIF
!
...
...
@@ -487,7 +480,7 @@
END
IF
OPEN
(
18
,
FILE
=
'bands'
//
spin12
(
jspin
))
ntb
=
minval
(
nevk
(:
))
ntb
=
minval
(
results
%
neig
(:,
jspin
))
kx
(
1
)
=
0.0
vkr
(:,
1
)
=
matmul
(
kpts
%
bk
(:,
1
),
cell
%
bmat
)
DO
k
=
2
,
kpts
%
nkpt
...
...
@@ -530,7 +523,7 @@
ENDDO
ENDIF
DEALLOCATE
(
qal
,
qval
,
qlay
,
qstars
)
DEALLOCATE
(
qal
,
qval
,
qlay
)
IF
(
l_mcd
)
DEALLOCATE
(
mcd
)
99001
FORMAT
(
f10.5
,
110
(
1x
,
e10.3
))
...
...
io/eig66_da.F90
View file @
cced8df0
...
...
@@ -266,12 +266,9 @@ CONTAINS
END
SUBROUTINE
write_eig
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
IN
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
IN
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
IN
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_DA
),
POINTER
::
d
...
...
@@ -282,20 +279,15 @@ CONTAINS
IF
(
d
%
l_orb
.AND.
PRESENT
(
qmtsl
))
THEN
IF
(
d
%
l_mcd
)
CPP_error
(
"mcd & orbital decomposition not implemented in IO"
)
WRITE
(
d
%
file_io_id_dos
,
REC
=
nrec
)
q
al
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
q
intsl
,
qmtsl
,
qmtp
,
orbcomp
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
)
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
ELSE
WRITE
(
d
%
file_io_id_dos
,
REC
=
nrec
)
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
WRITE
(
d
%
file_io_id_dos
,
REC
=
nrec
)
mcd
END
IF
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
OUT
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
OUT
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_DA
),
POINTER
::
d
...
...
@@ -306,11 +298,9 @@ CONTAINS
IF
(
d
%
l_orb
.AND.
PRESENT
(
qmtsl
))
THEN
IF
(
d
%
l_mcd
)
CPP_error
(
"mcd & orbital decomposition not implemented in IO"
)
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
q
al
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
q
intsl
,
qmtsl
,
qmtp
,
orbcomp
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
qintsl
,
qmtsl
,
qmtp
,
orbcomp
ELSEIF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
THEN
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
ELSE
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
mcd
END
IF
END
SUBROUTINE
read_dos
...
...
io/eig66_hdf.F90
View file @
cced8df0
...
...
@@ -294,28 +294,14 @@ CONTAINS
END
SUBROUTINE
priv_r_vec
#endif
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
OUT
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
OUT
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_HDF
),
POINTER
::
d
REAL
,
ALLOCATABLE
::
r_tmp5
(:,:,:,:,:)
CALL
priv_find_data
(
id
,
d
)
#ifdef CPP_HDF
CALL
io_read_real3
(
d
%
qalsetid
,(/
1
,
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qal
,
1
),
SIZE
(
qal
,
2
),
SIZE
(
qal
,
3
),
1
,
1
/),
qal
)
CALL
io_read_real2
(
d
%
qvacsetid
,(/
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qvac
,
1
),
SIZE
(
qvac
,
2
),
1
,
1
/),
qvac
)
CALL
io_read_real1
(
d
%
qissetid
,(/
1
,
nk
,
jspin
/),(/
SIZE
(
qis
,
1
),
1
,
1
/),
qis
)
CALL
io_read_real3
(
d
%
qvlaysetid
,(/
1
,
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qvlay
,
1
),
SIZE
(
qvlay
,
2
),
SIZE
(
qvlay
,
3
),
1
,
1
/),
qvlay
)
ALLOCATE
(
r_tmp5
(
2
,
SIZE
(
qstars
,
1
),
SIZE
(
qstars
,
2
),
SIZE
(
qstars
,
3
),
SIZE
(
qstars
,
4
)))
CALL
io_read_real5
(
d
%
qstarssetid
,(/
1
,
1
,
1
,
1
,
1
,
nk
,
jspin
/),(/
2
,
SIZE
(
qstars
,
1
),
SIZE
(
qstars
,
2
),
SIZE
(
qstars
,
3
),
SIZE
(
qstars
,
4
),
1
,
1
/),
r_tmp5
(:,:,:,:,:))
qstars
=
CMPLX
(
r_tmp5
(
1
,:,:,:,:),
r_tmp5
(
2
,:,:,:,:))
DEALLOCATE
(
r_tmp5
)
CALL
io_read_integer1
(
d
%
ksymsetid
,(/
1
,
nk
,
jspin
/),(/
SIZE
(
ksym
,
1
),
1
,
1
/),
ksym
)
CALL
io_read_integer1
(
d
%
jsymsetid
,(/
1
,
nk
,
jspin
/),(/
SIZE
(
jsym
,
1
),
1
,
1
/),
jsym
)
IF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
THEN
CALL
io_read_real3
(
d
%
mcdsetid
,(/
1
,
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
mcd
,
1
),
SIZE
(
mcd
,
2
),
SIZE
(
mcd
,
3
),
1
,
1
/),
mcd
)
ENDIF
...
...
@@ -329,26 +315,14 @@ CONTAINS
END
SUBROUTINE
read_dos
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
IN
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
IN
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
IN
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_HDF
),
POINTER
::
d
CALL
priv_find_data
(
id
,
d
)
#ifdef CPP_HDF
CALL
io_write_real3
(
d
%
qalsetid
,(/
1
,
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qal
,
1
),
SIZE
(
qal
,
2
),
SIZE
(
qal
,
3
),
1
,
1
/),
qal
)
CALL
io_write_real2
(
d
%
qvacsetid
,(/
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qvac
,
1
),
SIZE
(
qvac
,
2
),
1
,
1
/),
qvac
)
CALL
io_write_real1
(
d
%
qissetid
,(/
1
,
nk
,
jspin
/),(/
SIZE
(
qis
,
1
),
1
,
1
/),
qis
)
CALL
io_write_real3
(
d
%
qvlaysetid
,(/
1
,
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
qvlay
,
1
),
SIZE
(
qvlay
,
2
),
SIZE
(
qvlay
,
3
),
1
,
1
/),
qvlay
)
CALL
io_write_real4
(
d
%
qstarssetid
,(/
1
,
1
,
1
,
1
,
1
,
nk
,
jspin
/),(/
1
,
SIZE
(
qstars
,
1
),
SIZE
(
qstars
,
2
),
SIZE
(
qstars
,
3
),
SIZE
(
qstars
,
4
),
1
,
1
/),
REAL
(
qstars
))
CALL
io_write_real4
(
d
%
qstarssetid
,(/
2
,
1
,
1
,
1
,
1
,
nk
,
jspin
/),(/
1
,
SIZE
(
qstars
,
1
),
SIZE
(
qstars
,
2
),
SIZE
(
qstars
,
3
),
SIZE
(
qstars
,
4
),
1
,
1
/),
AIMAG
(
qstars
))
CALL
io_write_integer1
(
d
%
ksymsetid
,(/
1
,
nk
,
jspin
/),(/
SIZE
(
ksym
,
1
),
1
,
1
/),
ksym
)
CALL
io_write_integer1
(
d
%
jsymsetid
,(/
1
,
nk
,
jspin
/),(/
SIZE
(
jsym
,
1
),
1
,
1
/),
jsym
)
IF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
THEN
CALL
io_write_real3
(
d
%
mcdsetid
,(/
1
,
1
,
1
,
nk
,
jspin
/),(/
SIZE
(
mcd
,
1
),
SIZE
(
mcd
,
2
),
SIZE
(
mcd
,
3
),
1
,
1
/),
mcd
)
ENDIF
...
...
io/eig66_io.F90
View file @
cced8df0
...
...
@@ -167,7 +167,7 @@ CONTAINS
CALL
timestop
(
"IO (write)"
)
END
SUBROUTINE
write_eig
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
dos
,
slab
,
orbcomp
,
ksym
,
jsym
,
mcd
)
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
slab
,
orbcomp
,
mcd
)
USE
m_eig66_hdf
,
ONLY
:
write_dos_hdf
=>
write_dos
USE
m_eig66_DA
,
ONLY
:
write_dos_DA
=>
write_dos
USE
m_eig66_mem
,
ONLY
:
write_dos_MEM
=>
write_dos
...
...
@@ -175,29 +175,19 @@ CONTAINS
USE
m_types
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_orbcomp
),
INTENT
(
IN
)
::
orbcomp
TYPE
(
t_slab
),
INTENT
(
IN
)
::
slab
INTEGER
,
INTENT
(
IN
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
mcd
(:,:,:)
CALL
timestart
(
"IO (dos-write)"
)
SELECT
CASE
(
eig66_data_mode
(
id
))
CASE
(
da_mode
)
CALL
write_dos_DA
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
dos
%
qvac
(:,:,
nk
,
jspin
),&
dos
%
qis
(:,
nk
,
jspin
),
dos
%
qvlay
(:,:,:,
nk
,
jspin
),
dos
%
qstars
(:,:,:,:,
nk
,
jspin
),&
ksym
,
jsym
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_DA
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
hdf_mode
)
CALL
write_dos_HDF
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
dos
%
qvac
(:,:,
nk
,
jspin
),&
dos
%
qis
(:,
nk
,
jspin
),
dos
%
qvlay
(:,:,:,
nk
,
jspin
),
dos
%
qstars
(:,:,:,:,
nk
,
jspin
),&
ksym
,
jsym
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_HDF
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
mem_mode
)
CALL
write_dos_Mem
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
dos
%
qvac
(:,:,
nk
,
jspin
),&
dos
%
qis
(:,
nk
,
jspin
),
dos
%
qvlay
(:,:,:,
nk
,
jspin
),
dos
%
qstars
(:,:,:,:,
nk
,
jspin
),&
ksym
,
jsym
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_Mem
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
MPI_mode
)
CALL
write_dos_MPI
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
dos
%
qvac
(:,:,
nk
,
jspin
),&
dos
%
qis
(:,
nk
,
jspin
),
dos
%
qvlay
(:,:,:,
nk
,
jspin
),
dos
%
qstars
(:,:,:,:,
nk
,
jspin
),&
ksym
,
jsym
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CALL
write_dos_MPI
(
id
,
nk
,
jspin
,
mcd
,
slab
%
qintsl
,
slab
%
qmtsl
,
orbcomp
%
qmtp
,
orbcomp
%
comp
)
CASE
(
-1
)
CALL
juDFT_error
(
"Could not write DOS to eig-file before opening"
,
calledby
=
"eig66_io"
)
END
SELECT
...
...
@@ -205,28 +195,25 @@ CONTAINS
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
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
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
OUT
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
OUT
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
CALL
timestart
(
"IO (dos-read)"
)
SELECT
CASE
(
eig66_data_mode
(
id
))
CASE
(
da_mode
)
CALL
read_dos_DA
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_DA
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CASE
(
hdf_mode
)
CALL
read_dos_HDF
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_HDF
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CASE
(
mem_mode
)
CALL
read_dos_Mem
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_Mem
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CASE
(
MPI_mode
)
CALL
read_dos_MPI
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_MPI
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
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 @
cced8df0
...
...
@@ -151,12 +151,9 @@ CONTAINS
END
SUBROUTINE
priv_writetofile
END
SUBROUTINE
close_eig
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
IN
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
IN
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
IN
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
...
...
@@ -166,13 +163,6 @@ CONTAINS
nrec
=
nk
+
(
jspin
-1
)
*
d
%
nkpts
d
%
qal
(:,:,:,
nrec
)
=
qal
d
%
qvac
(:,:,
nrec
)
=
qvac
d
%
qis
(:,
nrec
)
=
qis
d
%
qvlay
(:,:,:,
nrec
)
=
qvlay
d
%
qstars
(:,:,:,:,
nrec
)
=
qstars
d
%
ksym
(:,
nrec
)
=
ksym
d
%
jsym
(:,
nrec
)
=
jsym
IF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
d
%
mcd
(:,:,:,
nrec
)
=
mcd
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
d
%
qintsl
(:,:,
nrec
)
=
qintsl
...
...
@@ -182,12 +172,9 @@ CONTAINS
ENDIF
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
OUT
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
OUT
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
...
...
@@ -197,13 +184,6 @@ CONTAINS
nrec
=
nk
+
(
jspin
-1
)
*
d
%
nkpts
qal
=
d
%
qal
(:,:,:,
nrec
)
qvac
=
d
%
qvac
(:,:,
nrec
)
qis
=
d
%
qis
(:,
nrec
)
qvlay
=
d
%
qvlay
(:,:,:,
nrec
)
qstars
=
d
%
qstars
(:,:,:,:,
nrec
)
ksym
=
d
%
ksym
(:,
nrec
)
jsym
=
d
%
jsym
(:,
nrec
)
IF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
mcd
=
d
%
mcd
(:,:,:,
nrec
)
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
qintsl
=
d
%
qintsl
(:,:,
nrec
)
...
...
io/eig66_mpi.F90
View file @
cced8df0
...
...
@@ -502,12 +502,9 @@ CONTAINS
END
SUBROUTINE
priv_get_data
#endif
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
IN
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
IN
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
IN
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
IN
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
#ifdef CPP_MPI
...
...
@@ -518,13 +515,6 @@ CONTAINS
pe
=
d
%
pe_basis
(
nk
,
jspin
)
slot
=
d
%
slot_basis
(
nk
,
jspin
)
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
qal
,(/
SIZE
(
qal
)/)),
d
%
qal_handle
)
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
qvac
,(/
SIZE
(
qvac
)/)),
d
%
qvac_handle
)
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
qis
,(/
SIZE
(
qis
)/)),
d
%
qis_handle
)
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
qvlay
,(/
SIZE
(
qvlay
)/)),
d
%
qvlay_handle
)
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
qstars
,(/
SIZE
(
qstars
)/)),
d
%
qstars_handle
)
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
ksym
,(/
SIZE
(
ksym
)/)),
d
%
ksym_handle
)
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
jsym
,(/
SIZE
(
jsym
)/)),
d
%
jsym_handle
)
IF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
mcd
,(/
SIZE
(
mcd
)/)),
d
%
mcd_handle
)
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
CALL
priv_put_data
(
pe
,
slot
,
RESHAPE
(
qintsl
,(/
SIZE
(
qintsl
)/)),
d
%
qintsl_handle
)
...
...
@@ -535,12 +525,9 @@ CONTAINS
#endif
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qal
,
qvac
,
qis
,
qvlay
,
qstars
,
ksym
,
jsym
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
out
)
::
qal
(:,:,:),
qvac
(:,:),
qis
(:),
qvlay
(:,:,:)
COMPLEX
,
INTENT
(
out
)
::
qstars
(:,:,:,:)
INTEGER
,
INTENT
(
out
)
::
ksym
(:),
jsym
(:)
REAL
,
INTENT
(
out
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
out
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
#ifdef CPP_MPI
...
...
@@ -551,13 +538,6 @@ CONTAINS
pe
=
d
%
pe_basis
(
nk
,
jspin
)
slot
=
d
%
slot_basis
(
nk
,
jspin
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qal
),
d
%
qal_handle
,
rdata
=
qal
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qvac
),
d
%
qvac_handle
,
rdata
=
qvac
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qis
),
d
%
qis_handle
,
rdata
=
qis
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qvlay
),
d
%
qvlay_handle
,
rdata
=
qvlay
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qstars
),
d
%
qstars_handle
,
cdata
=
qstars
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
ksym
),
d
%
ksym_handle
,
idata
=
ksym
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
jsym
),
d
%
jsym_handle
,
idata
=
jsym
)
IF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
mcd
),
d
%
mcd_handle
,
rdata
=
mcd
)
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qintsl
),
d
%
qintsl_handle
,
rdata
=
qintsl
)
...
...
main/cdngen.F90
View file @
cced8df0
...
...
@@ -104,7 +104,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
CALL
timestart
(
"cdngen: dos"
)
CALL
doswrite
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
banddos
,
sliceplot
,
noco
,
sym
,
cell
,
dos
,
mcd
,
results
,
slab
%
nsld
,
oneD
)
IF
(
banddos
%
dos
.AND.
(
banddos
%
ndir
.EQ.
-3
))
THEN
CALL
Ek_write_sl
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
jspmax
,
sym
,
cell
,
slab
)
CALL
Ek_write_sl
(
eig_id
,
dimension
,
kpts
,
atoms
,
vacuum
,
input
,
jspmax
,
sym
,
cell
,
dos
,
slab
)
END
IF
CALL
timestop
(
"cdngen: dos"
)
END
IF
...
...
Write
Preview
Markdown
is supported
0%