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
51
Issues
51
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
a5d130c7
Commit
a5d130c7
authored
Apr 27, 2018
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove mcd from read_dos
parent
cced8df0
Changes
11
Hide whitespace changes
Inline
Side-by-side
Showing
11 changed files
with
52 additions
and
58 deletions
+52
-58
cdn/cdnval.F90
cdn/cdnval.F90
+3
-3
cdn/eparas.f90
cdn/eparas.f90
+2
-2
dos/doswrite.f90
dos/doswrite.f90
+1
-2
dos/evaldos.f90
dos/evaldos.f90
+22
-25
io/eig66_da.F90
io/eig66_da.F90
+1
-4
io/eig66_hdf.F90
io/eig66_hdf.F90
+1
-5
io/eig66_io.F90
io/eig66_io.F90
+5
-6
io/eig66_mem.F90
io/eig66_mem.F90
+1
-3
io/eig66_mpi.F90
io/eig66_mpi.F90
+1
-3
mpi/mpi_col_den.F90
mpi/mpi_col_den.F90
+9
-1
types/types_cdnval.f90
types/types_cdnval.f90
+6
-4
No files found.
cdn/cdnval.F90
View file @
a5d130c7
...
...
@@ -139,7 +139,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL
denCoeffsOffdiag
%
init
(
atoms
,
noco
,
sphhar
,
.FALSE.
)
CALL
force
%
init1
(
input
,
atoms
)
CALL
orb
%
init
(
atoms
,
noco
,
jsp_start
,
jsp_end
)
CALL
mcd
%
init1
(
banddos
,
dimension
,
input
,
atoms
)
CALL
mcd
%
init1
(
banddos
,
dimension
,
input
,
atoms
,
kpts
)
CALL
slab
%
init
(
banddos
,
dimension
,
atoms
,
cell
)
CALL
orbcomp
%
init
(
banddos
,
dimension
,
atoms
)
...
...
@@ -271,13 +271,13 @@ 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
,
slab
,
orbcomp
,
mcd
%
mcd
)
CALL
write_dos
(
eig_id
,
ikpt
,
jspin
,
slab
,
orbcomp
,
mcd
%
mcd
(:,:,:,
ikpt
,
jspin
)
)
END
IF
END
DO
! end of k-point loop
#ifdef CPP_MPI
DO
ispin
=
jsp_start
,
jsp_end
CALL
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
ispin
,
regCharges
,
dos
,&
CALL
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
ispin
,
regCharges
,
dos
,
mcd
,
&
results
,
denCoeffs
,
orb
,
denCoeffsOffdiag
,
den
,
den
%
mmpMat
(:,:,:,
jspin
))
END
DO
#endif
...
...
cdn/eparas.f90
View file @
a5d130c7
...
...
@@ -61,7 +61,7 @@ CONTAINS
IF
((
ikpt
.LE.
mpi
%
isize
)
.AND..NOT.
l_evp
)
THEN
IF
(
l_mcd
)
THEN
mcd
%
mcd
(:,:,:)
=
0.0
mcd
%
mcd
(:,:,:
,
ikpt
,
jsp
)
=
0.0
ENDIF
regCharges
%
ener
(:,:,
jsp
)
=
0.0
regCharges
%
sqal
(:,:,
jsp
)
=
0.0
...
...
@@ -101,7 +101,7 @@ CONTAINS
DO
icore
=
1
,
mcd
%
ncore
(
n
)
DO
ipol
=
1
,
3
index
=
3
*
(
n
-1
)
+
ipol
mcd
%
mcd
(
index
,
icore
,
i
)
=
mcd
%
mcd
(
index
,
icore
,
i
)
+
fac
*
(&
mcd
%
mcd
(
index
,
icore
,
i
,
ikpt
,
jsp
)
=
mcd
%
mcd
(
index
,
icore
,
i
,
ikpt
,
jsp
)
+
fac
*
(&
suma
*
CONJG
(
mcd
%
m_mcd
(
icore
,
lm
+1
,
index
,
1
))
*
mcd
%
m_mcd
(
icore
,
lm
+1
,
index
,
1
)
+
&
sumb
*
CONJG
(
mcd
%
m_mcd
(
icore
,
lm
+1
,
index
,
2
))
*
mcd
%
m_mcd
(
icore
,
lm
+1
,
index
,
2
)
+
&
sumab
*
CONJG
(
mcd
%
m_mcd
(
icore
,
lm
+1
,
index
,
2
))
*
mcd
%
m_mcd
(
icore
,
lm
+1
,
index
,
1
)
+
&
...
...
dos/doswrite.f90
View file @
a5d130c7
...
...
@@ -13,7 +13,6 @@ MODULE m_doswrite
CONTAINS
SUBROUTINE
doswrite
(
eig_id
,
DIMENSION
,
kpts
,
atoms
,
vacuum
,
input
,
banddos
,&
sliceplot
,
noco
,
sym
,
cell
,
dos
,
mcd
,
results
,
nsld
,
oneD
)
USE
m_eig66_io
,
ONLY
:
read_dos
,
read_eig
USE
m_evaldos
USE
m_cdninf
USE
m_types
...
...
@@ -104,7 +103,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
%
ncore
,
mcd
%
e_mcd
,
nsld
)
DIMENSION
,
results
%
ef
,
results
%
bandgap
,
banddos
%
l_mcd
,
mcd
,
nsld
)
END
IF
! Now write to vacwave if nstm=3
...
...
dos/evaldos.f90
View file @
a5d130c7
MODULE
m_evaldos
CONTAINS
SUBROUTINE
evaldos
(
eig_id
,
input
,
banddos
,
vacuum
,
kpts
,
atoms
,
sym
,
noco
,
oneD
,
cell
,
results
,
dos
,&
dimension
,
efermiarg
,
bandgap
,
l_mcd
,
ncore
,
e_
mcd
,
nsld
)
dimension
,
efermiarg
,
bandgap
,
l_mcd
,
mcd
,
nsld
)
!----------------------------------------------------------------------
!
! vk: k-vectors
...
...
@@ -19,7 +19,7 @@
! ntb=max(nevk)
!
!----------------------------------------------------------------------
USE
m_eig66_io
,
ONLY
:
read_dos
,
read_eig
USE
m_eig66_io
,
ONLY
:
read_dos
USE
m_triang
USE
m_maketetra
USE
m_tetrados
...
...
@@ -41,17 +41,14 @@
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_results
),
INTENT
(
IN
)
::
results
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_mcd
),
INTENT
(
IN
)
::
mcd
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
INTEGER
,
INTENT
(
IN
)
::
ncore
(
atoms
%
ntype
)
!(ntype)
REAL
,
INTENT
(
IN
)
::
e_mcd
(
atoms
%
ntype
,
input
%
jspins
,
dimension
%
nstd
)
!-odim
!+odim
! locals
INTEGER
,
PARAMETER
::
lmax
=
4
,
ned
=
1301
INTEGER
i
,
s
,
v
,
index
,
jspin
,
k
,
l
,
l1
,
l2
,
ln
,
n
,
nl
,
ntb
,
ntria
,
ntetra
...
...
@@ -65,14 +62,14 @@
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
(:,:)
REAL
,
ALLOCATABLE
::
mcd
(:,:,:),
orbcomp
(:,:,:),
qmtp
(:,:)
REAL
,
ALLOCATABLE
::
mcd
_local
(:,:,:),
orbcomp
(:,:,:),
qmtp
(:,:)
REAL
,
ALLOCATABLE
::
qintsl
(:,:),
qmtsl
(:,:),
qvac
(:,:)
CHARACTER
(
len
=
2
)
::
spin12
(
2
),
ch_mcd
(
3
)
CHARACTER
(
len
=
8
)
::
chntype
*
2
,
chform
*
19
DATA
spin12
/
'.1'
,
'.2'
/
DATA
ch_mcd
/
'.+'
,
'.-'
,
'.0'
/
ncored
=
MAX
(
0
,
MAXVAL
(
ncore
))
ncored
=
MAX
(
0
,
MAXVAL
(
mcd
%
ncore
))
qdim
=
lmax
*
atoms
%
ntype
+3
l_orbcomp
=
banddos
%
l_orb
IF
(
banddos
%
ndir
.EQ.
-3
)
THEN
...
...
@@ -88,9 +85,9 @@
&
qval
(
vacuum
%
nstars
*
vacuum
%
layers
*
vacuum
%
nvac
,
dimension
%
neigd
,
kpts
%
nkpt
),&
&
qlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
))
IF
(
l_mcd
)
THEN
ALLOCATE
(
mcd
(
3
*
atoms
%
ntype
*
ncored
,
dimension
%
neigd
,
kpts
%
nkpt
)
)
ALLOCATE
(
mcd_local
(
3
*
atoms
%
ntype
*
ncored
,
dimension
%
neigd
,
kpts
%
nkpt
)
)
ELSE
ALLOCATE
(
mcd
(
0
,
0
,
0
))
ALLOCATE
(
mcd
_local
(
0
,
0
,
0
))
ENDIF
!
! scale energies
...
...
@@ -126,9 +123,9 @@
e_up
=
-9.9d+9
DO
jspin
=
1
,
input
%
jspins
DO
n
=
1
,
atoms
%
ntype
DO
icore
=
1
,
ncore
(
n
)
e_lo
=
min
(
e_mcd
(
n
,
jspin
,
icore
),
e_lo
)
e_up
=
max
(
e_mcd
(
n
,
jspin
,
icore
),
e_up
)
DO
icore
=
1
,
mcd
%
ncore
(
n
)
e_lo
=
min
(
mcd
%
e_mcd
(
n
,
jspin
,
icore
),
e_lo
)
e_up
=
max
(
mcd
%
e_mcd
(
n
,
jspin
,
icore
),
e_up
)
ENDDO
ENDDO
ENDDO
...
...
@@ -156,12 +153,13 @@
qval
(
i
,
n
,
k
)
=
0.
ENDDO
ENDDO
!
! read data from file!
!
ntb
=
max
(
ntb
,
results
%
neig
(
k
,
jspin
))
ALLOCATE
(
orbcomp
(
dimension
%
neigd
,
23
,
atoms
%
nat
),
qintsl
(
nsld
,
dimension
%
neigd
))
ALLOCATE
(
qmtsl
(
nsld
,
dimension
%
neigd
),
qmtp
(
dimension
%
neigd
,
atoms
%
nat
))
CALL
read_dos
(
eig_id
,
k
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos
(
eig_id
,
k
,
jspin
,
qintsl
,
qmtsl
,
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
)/))
qal
(
lmax
*
atoms
%
ntype
+2
,:,
k
)
=
dos
%
qvac
(:,
1
,
k
,
jspin
)
! vacuum 1
...
...
@@ -183,7 +181,6 @@
END
IF
END
IF
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
...
...
@@ -332,7 +329,7 @@
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
,&
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
)
results
%
neig
(:,
jspin
),
kpts
%
wtkpt
(
1
:
kpts
%
nkpt
),
ev
(
1
:
ntb
,
1
:
kpts
%
nkpt
),
mcd
_local
(
1
:
3
*
atoms
%
ntype
*
ncored
,
1
:
ntb
,
1
:
kpts
%
nkpt
),
g
)
ENDIF
ENDIF
!
...
...
@@ -401,18 +398,18 @@
CLOSE
(
18
)
ELSE
write
(
*
,
'(4f15.8)'
)
((
e_mcd
(
n
,
jspin
,
i
),
n
=
1
,
atoms
%
ntype
),
i
=
1
,
ncored
)
write
(
*
,
'(4f15.8)'
)
((
mcd
%
e_mcd
(
n
,
jspin
,
i
),
n
=
1
,
atoms
%
ntype
),
i
=
1
,
ncored
)
write
(
*
,
*
)
write
(
*
,
'(4f15.8)'
)
(
g
(
800
,
n
),
n
=
1
,
3
*
atoms
%
ntype
*
ncored
)
write
(
*
,
*
)
write
(
*
,
'(4f15.8)'
)
(
mcd
(
n
,
10
,
8
),
n
=
1
,
3
*
atoms
%
ntype
*
ncored
)
write
(
*
,
'(4f15.8)'
)
(
mcd
_local
(
n
,
10
,
8
),
n
=
1
,
3
*
atoms
%
ntype
*
ncored
)
DO
n
=
1
,
atoms
%
ntype
DO
l
=
1
,
ned
DO
icore
=
1
,
ncore
(
n
)
DO
icore
=
1
,
mcd
%
ncore
(
n
)
DO
i
=
1
,
ned
-1
IF
(
e
(
i
)
.GT.
0
)
THEN
! take unoccupied part only
e_test1
=
-
e
(
i
)
-
efermi
+
e_mcd
(
n
,
jspin
,
icore
)
*
hartree_to_ev_const
e_test2
=
-
e
(
i
+1
)
-
efermi
+
e_mcd
(
n
,
jspin
,
icore
)
*
hartree_to_ev_const
e_test1
=
-
e
(
i
)
-
efermi
+
mcd
%
e_mcd
(
n
,
jspin
,
icore
)
*
hartree_to_ev_const
e_test2
=
-
e
(
i
+1
)
-
efermi
+
mcd
%
e_mcd
(
n
,
jspin
,
icore
)
*
hartree_to_ev_const
IF
((
e_test2
.LE.
e_grid
(
l
))
.AND.
(
e_test1
.GT.
e_grid
(
l
)))
THEN
fac
=
(
e_grid
(
l
)
-
e_test1
)/(
e_test2
-
e_test1
)
DO
k
=
3
*
(
n
-1
)
+1
,
3
*
(
n
-1
)
+3
...
...
@@ -524,7 +521,7 @@
ENDIF
DEALLOCATE
(
qal
,
qval
,
qlay
)
IF
(
l_mcd
)
DEALLOCATE
(
mcd
)
IF
(
l_mcd
)
DEALLOCATE
(
mcd
_local
)
99001
FORMAT
(
f10.5
,
110
(
1x
,
e10.3
))
END
SUBROUTINE
evaldos
...
...
io/eig66_da.F90
View file @
a5d130c7
...
...
@@ -285,10 +285,9 @@ CONTAINS
END
IF
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_DA
),
POINTER
::
d
INTEGER
::
nrec
...
...
@@ -299,8 +298,6 @@ 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
)
qintsl
,
qmtsl
,
qmtp
,
orbcomp
ELSEIF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
THEN
READ
(
d
%
file_io_id_dos
,
REC
=
nrec
)
mcd
END
IF
END
SUBROUTINE
read_dos
...
...
io/eig66_hdf.F90
View file @
a5d130c7
...
...
@@ -294,17 +294,13 @@ CONTAINS
END
SUBROUTINE
priv_r_vec
#endif
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
TYPE
(
t_data_HDF
),
POINTER
::
d
CALL
priv_find_data
(
id
,
d
)
#ifdef CPP_HDF
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
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
)
...
...
io/eig66_io.F90
View file @
a5d130c7
...
...
@@ -195,25 +195,24 @@ CONTAINS
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
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
),
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
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_DA
(
id
,
nk
,
jspin
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CASE
(
hdf_mode
)
CALL
read_dos_HDF
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_HDF
(
id
,
nk
,
jspin
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CASE
(
mem_mode
)
CALL
read_dos_Mem
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_Mem
(
id
,
nk
,
jspin
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CASE
(
MPI_mode
)
CALL
read_dos_MPI
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
CALL
read_dos_MPI
(
id
,
nk
,
jspin
,
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 @
a5d130c7
...
...
@@ -172,10 +172,9 @@ CONTAINS
ENDIF
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
OUT
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
INTEGER
::
nrec
...
...
@@ -184,7 +183,6 @@ CONTAINS
nrec
=
nk
+
(
jspin
-1
)
*
d
%
nkpts
IF
(
d
%
l_mcd
.AND.
PRESENT
(
mcd
))
mcd
=
d
%
mcd
(:,:,:,
nrec
)
IF
(
d
%
l_orb
.AND.
PRESENT
(
qintsl
))
THEN
qintsl
=
d
%
qintsl
(:,:,
nrec
)
qmtsl
=
d
%
qmtsl
(:,:,
nrec
)
...
...
io/eig66_mpi.F90
View file @
a5d130c7
...
...
@@ -525,10 +525,9 @@ CONTAINS
#endif
END
SUBROUTINE
write_dos
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
mcd
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
SUBROUTINE
read_dos
(
id
,
nk
,
jspin
,
qintsl
,
qmtsl
,
qmtp
,
orbcomp
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
REAL
,
INTENT
(
out
),
OPTIONAL
::
mcd
(:,:,:)
REAL
,
INTENT
(
out
),
OPTIONAL
::
qintsl
(:,:),
qmtsl
(:,:),
qmtp
(:,:),
orbcomp
(:,:,:)
#ifdef CPP_MPI
TYPE
(
t_data_MPI
),
POINTER
::
d
...
...
@@ -538,7 +537,6 @@ CONTAINS
pe
=
d
%
pe_basis
(
nk
,
jspin
)
slot
=
d
%
slot_basis
(
nk
,
jspin
)
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
)
CALL
priv_get_data
(
pe
,
slot
,
SIZE
(
qmtsl
),
d
%
qmtsl_handle
,
rdata
=
qmtsl
)
...
...
mpi/mpi_col_den.F90
View file @
a5d130c7
...
...
@@ -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
,&
SUBROUTINE
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
jspin
,
regCharges
,
dos
,
mcd
,
&
results
,
denCoeffs
,
orb
,
denCoeffsOffdiag
,
den
,
n_mmp
)
#include"cpp_double.h"
...
...
@@ -40,6 +40,7 @@ CONTAINS
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
INOUT
)
::
denCoeffsOffdiag
TYPE
(
t_regionCharges
),
INTENT
(
INOUT
)
::
regCharges
TYPE
(
t_dos
),
INTENT
(
INOUT
)
::
dos
TYPE
(
t_mcd
),
INTENT
(
INOUT
)
::
mcd
! ..
! .. Local Scalars ..
INTEGER
::
n
,
i
...
...
@@ -173,6 +174,13 @@ CONTAINS
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_ccopy
(
n
,
c_b
,
1
,
dos
%
qstars
(:,:,:,:,:,
jspin
),
1
)
DEALLOCATE
(
c_b
)
! Collect mcd%mcd
n
=
SIZE
(
mcd
%
mcd
,
1
)
*
SIZE
(
mcd
%
mcd
,
2
)
*
SIZE
(
mcd
%
mcd
,
3
)
*
SIZE
(
mcd
%
mcd
,
4
)
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
mcd
%
mcd
(:,:,:,:,
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
,
mcd
%
mcd
(:,:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
! -> Collect force
IF
(
input
%
l_f
)
THEN
n
=
3
*
atoms
%
ntype
...
...
types/types_cdnval.f90
View file @
a5d130c7
...
...
@@ -89,7 +89,7 @@ PRIVATE
INTEGER
,
ALLOCATABLE
::
ncore
(:)
REAL
,
ALLOCATABLE
::
e_mcd
(:,:,:)
REAL
,
ALLOCATABLE
::
mcd
(:,:,:)
REAL
,
ALLOCATABLE
::
mcd
(:,:,:
,:,:
)
COMPLEX
,
ALLOCATABLE
::
m_mcd
(:,:,:,:)
CONTAINS
...
...
@@ -362,9 +362,10 @@ SUBROUTINE eigVecCoeffs_init(thisEigVecCoeffs,dimension,atoms,noco,jspin,noccbd)
END
SUBROUTINE
eigVecCoeffs_init
SUBROUTINE
mcd_init1
(
thisMCD
,
banddos
,
dimension
,
input
,
atoms
)
SUBROUTINE
mcd_init1
(
thisMCD
,
banddos
,
dimension
,
input
,
atoms
,
kpts
)
USE
m_types_setup
USE
m_types_kpts
IMPLICIT
NONE
...
...
@@ -373,6 +374,7 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms)
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
IF
(
ALLOCATED
(
thisMCD
%
ncore
))
DEALLOCATE
(
thisMCD
%
ncore
)
IF
(
ALLOCATED
(
thisMCD
%
e_mcd
))
DEALLOCATE
(
thisMCD
%
e_mcd
)
...
...
@@ -385,11 +387,11 @@ SUBROUTINE mcd_init1(thisMCD,banddos,dimension,input,atoms)
thisMCD
%
emcd_lo
=
banddos
%
e_mcd_lo
thisMCD
%
emcd_up
=
banddos
%
e_mcd_up
ALLOCATE
(
thisMCD
%
m_mcd
(
dimension
%
nstd
,(
3+1
)
**
2
,
3
*
atoms
%
ntype
,
2
))
ALLOCATE
(
thisMCD
%
mcd
(
3
*
atoms
%
ntype
,
dimension
%
nstd
,
dimension
%
neigd
)
)
ALLOCATE
(
thisMCD
%
mcd
(
3
*
atoms
%
ntype
,
dimension
%
nstd
,
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
)
)
IF
(
.NOT.
banddos
%
dos
)
WRITE
(
*
,
*
)
'For mcd-spectra set banddos%dos=T!'
ELSE
ALLOCATE
(
thisMCD
%
m_mcd
(
1
,
1
,
1
,
1
))
ALLOCATE
(
thisMCD
%
mcd
(
1
,
1
,
1
))
ALLOCATE
(
thisMCD
%
mcd
(
1
,
1
,
1
,
1
,
input
%
jspins
))
ENDIF
thisMCD
%
ncore
=
0
...
...
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