Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
fleur
fleur
Commits
bd99a389
Commit
bd99a389
authored
Apr 27, 2018
by
Gregor Michalicek
Browse files
Remove requirement for read_dos, write_dos subroutines (part 1)
(at the moment this is broken)
parent
9ffd69d4
Changes
6
Hide whitespace changes
Inline
Side-by-side
cdn/cdnval.F90
View file @
bd99a389
...
...
@@ -95,7 +95,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
LOGICAL
::
l_orbcomprot
,
l_real
,
l_write
,
l_dosNdir
! Local Arrays
INTEGER
,
ALLOCATABLE
::
jsym
(:),
ksym
(:)
REAL
,
ALLOCATABLE
::
we
(:)
REAL
,
ALLOCATABLE
::
eig
(:)
REAL
,
ALLOCATABLE
::
f
(:,:,:,:),
g
(:,:,:,:),
flo
(:,:,:,:)
! radial functions
...
...
@@ -131,7 +130,6 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
ALLOCATE
(
f
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
,
jsp_start
:
jsp_end
))
! Deallocation before mpi_col_den
ALLOCATE
(
g
(
atoms
%
jmtd
,
2
,
0
:
atoms
%
lmaxd
,
jsp_start
:
jsp_end
))
ALLOCATE
(
flo
(
atoms
%
jmtd
,
2
,
atoms
%
nlod
,
dimension
%
jspd
))
ALLOCATE
(
jsym
(
dimension
%
neigd
),
ksym
(
dimension
%
neigd
))
! Initializations
CALL
usdus
%
init
(
atoms
,
input
%
jspins
)
...
...
@@ -271,15 +269,15 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
IF
((
banddos
%
dos
.OR.
banddos
%
vacdos
.OR.
input
%
cdinf
))
THEN
! 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
,
ksym
,
jsym
,
zMat
)
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
,
ksym
,
jsym
,
mcd
%
mcd
)
CALL
write_dos
(
eig_id
,
ikpt
,
jspin
,
dos
,
slab
,
orbcomp
,
dos
%
ksym
(:,
ikpt
,
jspin
),
dos
%
jsym
(:,
ikpt
,
jspin
)
,
mcd
%
mcd
)
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
,&
CALL
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
ispin
,
regCharges
,
dos
,
&
results
,
denCoeffs
,
orb
,
denCoeffsOffdiag
,
den
,
den
%
mmpMat
(:,:,:,
jspin
))
END
DO
#endif
...
...
dos/doswrite.f90
View file @
bd99a389
...
...
@@ -12,7 +12,7 @@ MODULE m_doswrite
!
CONTAINS
SUBROUTINE
doswrite
(
eig_id
,
DIMENSION
,
kpts
,
atoms
,
vacuum
,
input
,
banddos
,&
sliceplot
,
noco
,
sym
,
cell
,
mcd
,
results
,
nsld
,
oneD
)
sliceplot
,
noco
,
sym
,
cell
,
dos
,
mcd
,
results
,
nsld
,
oneD
)
USE
m_eig66_io
,
ONLY
:
read_dos
,
read_eig
USE
m_evaldos
USE
m_cdninf
...
...
@@ -28,6 +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_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_mcd
),
INTENT
(
IN
)
::
mcd
...
...
@@ -71,13 +72,11 @@ CONTAINS
ENDIF
IF
((
banddos
%
dos
.AND.
(
banddos
%
ndir
.GE.
0
))
.OR.
input
%
cdinf
)
THEN
!
! write bandstructure or cdn-info to output-file
!
DO
kspin
=
1
,
input
%
jspins
IF
(
banddos
%
dos
.AND.
(
banddos
%
ndir
.GE.
0
))
THEN
!--- > write header information to vacdos & dosinp
!
! write header information to vacdos & dosinp
IF
(
input
%
film
)
THEN
WRITE
(
85
,
FMT
=
8080
)
vacuum
%
nvac
,
kpts
%
nkpt
ELSE
...
...
@@ -93,47 +92,40 @@ 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 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
,
ne
,
eig
,
qal
(
0
:,:,:,
kspin
),
qis
,
qvac
,&
qvlay
(:,:,:
),
qstars
,
ksym
,
jsym
)
ENDDO
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
)
)
END
DO
ENDDO
! end spin loop (kspin = 1,input%jspins)
END
DO
! end spin loop (kspin = 1,input%jspins)
ENDIF
END
IF
IF
(
banddos
%
dos
.AND.
(
banddos
%
ndir
.GE.
0
))
THEN
CLOSE
(
85
)
RETURN
! ok, all done in the bandstructure/cdninf case
ENDIF
!
! write DOS/VACDOS
!
!
END
IF
! 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
,&
DIMENSION
,
results
%
ef
,
results
%
bandgap
,&
banddos
%
l_mcd
,
mcd
%
ncore
,
mcd
%
e_mcd
,
nsld
)
ENDIF
!
! Now write to vacwave if nstm=3
! all data
! has been written to tmp_vacwave and must be written now
! by PE=0 only!
!
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
)
END
IF
! Now write to vacwave if nstm=3
! all data has been written to tmp_vacwave and must be written now by PE=0 only!
IF
(
vacuum
%
nstm
.EQ.
3
)
THEN
call
juDFT_error
(
"nstm=3 not implemented in doswrite"
)
!OPEN (89,file='tmp_vacwave',status='old',access='direct')!, recl=reclength_vw)
ALLOCATE
(
ac
(
n2max
,
DIMENSION
%
neigd
),
bc
(
n2max
,
DIMENSION
%
neigd
)
)
DO
ikpt
=
1
,
kpts
%
nkpt
WRITE
(
*
,
*
)
'Read rec'
,
ikpt
,
'from vacwave'
READ
(
89
,
rec
=
ikpt
)
wk
,
ne
,
bkpt
(
1
),
bkpt
(
2
),&
&
eig
,
ac
,
bc
READ
(
89
,
rec
=
ikpt
)
wk
,
ne
,
bkpt
(
1
),
bkpt
(
2
),
eig
,
ac
,
bc
WRITE
(
87
,
'(i3,1x,f12.6)'
)
ikpt
,
wk
i
=
0
DO
n
=
1
,
ne
...
...
dos/evaldos.f90
View file @
bd99a389
MODULE
m_evaldos
CONTAINS
SUBROUTINE
evaldos
(
eig_id
,
input
,
banddos
,
vacuum
,
kpts
,
atoms
,
sym
,
noco
,
oneD
,
cell
,&
dimension
,
efermiarg
,
bandgap
,
l_mcd
,
ncore
,
e_mcd
,
nsld
)
SUBROUTINE
evaldos
(
eig_id
,
input
,
banddos
,
vacuum
,
kpts
,
atoms
,
sym
,
noco
,
oneD
,
cell
,
results
,
dos
,
&
dimension
,
efermiarg
,
bandgap
,
l_mcd
,
ncore
,
e_mcd
,
nsld
)
!----------------------------------------------------------------------
!
! vk: k-vectors
...
...
@@ -39,6 +39,8 @@
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_results
),
INTENT
(
IN
)
::
results
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
...
...
main/cdngen.F90
View file @
bd99a389
...
...
@@ -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
,
mcd
,
results
,
slab
%
nsld
,
oneD
)
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
)
END
IF
...
...
mpi/mpi_col_den.F90
View file @
bd99a389
...
...
@@ -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
,&
SUBROUTINE
mpi_col_den
(
mpi
,
sphhar
,
atoms
,
oneD
,
stars
,
vacuum
,
input
,
noco
,
jspin
,
regCharges
,
dos
,
&
results
,
denCoeffs
,
orb
,
denCoeffsOffdiag
,
den
,
n_mmp
)
#include"cpp_double.h"
...
...
@@ -39,6 +39,7 @@ CONTAINS
TYPE
(
t_denCoeffs
),
INTENT
(
INOUT
)
::
denCoeffs
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
INOUT
)
::
denCoeffsOffdiag
TYPE
(
t_regionCharges
),
INTENT
(
INOUT
)
::
regCharges
TYPE
(
t_dos
),
INTENT
(
INOUT
)
::
dos
! ..
! .. Local Scalars ..
INTEGER
::
n
...
...
@@ -47,6 +48,7 @@ CONTAINS
INTEGER
::
ierr
(
3
)
COMPLEX
,
ALLOCATABLE
::
c_b
(:)
REAL
,
ALLOCATABLE
::
r_b
(:)
INTEGER
,
ALLOCATABLE
::
i_b
(:)
! ..
! .. External Subroutines
EXTERNAL
CPP_BLAS_scopy
,
CPP_BLAS_ccopy
,
MPI_REDUCE
...
...
@@ -57,121 +59,122 @@ CONTAINS
n
=
stars
%
ng3
ALLOCATE
(
c_b
(
n
))
CALL
MPI_REDUCE
(
den
%
pw
(:,
jspin
),
c_b
,
n
,
CPP_MPI_COMPLEX
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_ccopy
(
n
,
c_b
,
1
,
den
%
pw
(:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_ccopy
(
n
,
c_b
,
1
,
den
%
pw
(:,
jspin
),
1
)
DEALLOCATE
(
c_b
)
! -> Collect den%vacxy(:,:,:,jspin)
IF
(
input
%
film
)
THEN
n
=
vacuum
%
nmzxyd
*
(
oneD
%
odi
%
n2d
-1
)
*
2
ALLOCATE
(
c_b
(
n
))
CALL
MPI_REDUCE
(
den
%
vacxy
(:,:,:,
jspin
),
c_b
,
n
,
CPP_MPI_COMPLEX
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_ccopy
(
n
,
c_b
,
1
,
den
%
vacxy
(:,:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_ccopy
(
n
,
c_b
,
1
,
den
%
vacxy
(:,:,:,
jspin
),
1
)
DEALLOCATE
(
c_b
)
! -> Collect den%vacz(:,:,jspin)
n
=
vacuum
%
nmzd
*
2
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
den
%
vacz
(:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
den
%
vacz
(:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
den
%
vacz
(:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
ENDIF
!
! -> Collect uu(),ud() and dd()
!
n
=
(
atoms
%
lmaxd
+1
)
*
atoms
%
ntype
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
denCoeffs
%
uu
(
0
:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
uu
(
0
:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
uu
(
0
:,:,
jspin
),
1
)
CALL
MPI_REDUCE
(
denCoeffs
%
du
(
0
:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
du
(
0
:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
du
(
0
:,:,
jspin
),
1
)
CALL
MPI_REDUCE
(
denCoeffs
%
dd
(
0
:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
dd
(
0
:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
dd
(
0
:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
!
!--> Collect uunmt,udnmt,dunmt,ddnmt
!
n
=
(((
atoms
%
lmaxd
*
(
atoms
%
lmaxd
+3
))/
2
)
+1
)
*
sphhar
%
nlhd
*
atoms
%
ntype
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
denCoeffs
%
uunmt
(
0
:,:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
uunmt
(
0
:,:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
uunmt
(
0
:,:,:,
jspin
),
1
)
CALL
MPI_REDUCE
(
denCoeffs
%
udnmt
(
0
:,:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
udnmt
(
0
:,:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
udnmt
(
0
:,:,:,
jspin
),
1
)
CALL
MPI_REDUCE
(
denCoeffs
%
dunmt
(
0
:,:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
dunmt
(
0
:,:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
dunmt
(
0
:,:,:,
jspin
),
1
)
CALL
MPI_REDUCE
(
denCoeffs
%
ddnmt
(
0
:,:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
ddnmt
(
0
:,:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
denCoeffs
%
ddnmt
(
0
:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
!
!--> ener & sqal
!
n
=
4
*
atoms
%
ntype
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
regCharges
%
ener
(:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
ener
(:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
ener
(:,:,
jspin
),
1
)
CALL
MPI_REDUCE
(
regCharges
%
sqal
(:,:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
sqal
(:,:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
sqal
(:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
!
!--> svac & pvac
!
IF
(
input
%
film
)
THEN
n
=
2
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
regCharges
%
svac
(:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
svac
(:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
svac
(:,
jspin
),
1
)
CALL
MPI_REDUCE
(
regCharges
%
pvac
(:,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
pvac
(:,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
regCharges
%
pvac
(:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
ENDIF
!
!collect DOS stuff
n
=
SIZE
(
dos
%
jsym
,
1
)
*
SIZE
(
dos
%
jsym
,
2
)
ALLOCATE
(
i_b
(
n
))
CALL
MPI_REDUCE
(
dos
%
jsym
(:,:,
jspin
),
i_b
,
n
,
MPI_INTEGER
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
i_b
,
1
,
dos
%
jsym
(:,:,
jspin
),
1
)
DEALLOCATE
(
i_b
)
n
=
SIZE
(
dos
%
ksym
,
1
)
*
SIZE
(
dos
%
ksym
,
2
)
ALLOCATE
(
i_b
(
n
))
CALL
MPI_REDUCE
(
dos
%
ksym
(:,:,
jspin
),
i_b
,
n
,
MPI_INTEGER
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
i_b
,
1
,
dos
%
ksym
(:,:,
jspin
),
1
)
DEALLOCATE
(
i_b
)
n
=
SIZE
(
dos
%
qis
,
1
)
*
SIZE
(
dos
%
qis
,
2
)
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
dos
%
qis
(:,:,
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
,
dos
%
qis
(:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
n
=
SIZE
(
dos
%
qal
,
1
)
*
SIZE
(
dos
%
qal
,
2
)
*
SIZE
(
dos
%
qal
,
3
)
*
SIZE
(
dos
%
qal
,
4
)
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
dos
%
qal
(
0
:,:,:,:,
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
,
dos
%
qal
(
0
:,:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
n
=
SIZE
(
dos
%
qvac
,
1
)
*
SIZE
(
dos
%
qvac
,
2
)
*
SIZE
(
dos
%
qvac
,
3
)
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
dos
%
qvac
(:,:,:,
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
,
dos
%
qvac
(:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
n
=
SIZE
(
dos
%
qvlay
,
1
)
*
SIZE
(
dos
%
qvlay
,
2
)
*
SIZE
(
dos
%
qvlay
,
3
)
*
SIZE
(
dos
%
qvlay
,
4
)
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
dos
%
qvlay
(:,:,:,:,
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
,
dos
%
qvlay
(:,:,:,:,
jspin
),
1
)
DEALLOCATE
(
r_b
)
n
=
SIZE
(
dos
%
qstars
,
1
)
*
SIZE
(
dos
%
qstars
,
2
)
*
SIZE
(
dos
%
qstars
,
3
)
*
SIZE
(
dos
%
qstars
,
4
)
*
SIZE
(
dos
%
qstars
,
5
)
ALLOCATE
(
c_b
(
n
))
CALL
MPI_REDUCE
(
dos
%
qstars
(:,:,:,:,:,
jspin
),
c_b
,
n
,
CPP_MPI_COMPLEX
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
c_b
,
1
,
dos
%
qstars
(:,:,:,:,:,
jspin
),
1
)
DEALLOCATE
(
c_b
)
! -> Collect force
!
IF
(
input
%
l_f
)
THEN
n
=
3
*
atoms
%
ntype
ALLOCATE
(
r_b
(
n
))
CALL
MPI_REDUCE
(
results
%
force
(
1
,
1
,
jspin
),
r_b
,
n
,
CPP_MPI_REAL
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
IF
(
mpi
%
irank
.EQ.
0
)
THEN
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
results
%
force
(
1
,
1
,
jspin
),
1
)
ENDIF
IF
(
mpi
%
irank
.EQ.
0
)
CALL
CPP_BLAS_scopy
(
n
,
r_b
,
1
,
results
%
force
(
1
,
1
,
jspin
),
1
)
DEALLOCATE
(
r_b
)
ENDIF
!
! -> Optional the LO-coefficients: aclo,bclo,enerlo,cclo,acnmt,bcnmt,ccnmt
!
IF
(
atoms
%
nlod
.GE.
1
)
THEN
n
=
atoms
%
nlod
*
atoms
%
ntype
...
...
@@ -223,11 +226,9 @@ CONTAINS
DEALLOCATE
(
r_b
)
ENDIF
!
! -> Now the SOC - stuff: orb, orblo and orblo
!
IF
(
noco
%
l_soc
)
THEN
!
! orb
n
=
(
atoms
%
lmaxd
+1
)
*
(
2
*
atoms
%
lmaxd
+1
)
*
atoms
%
ntype
ALLOCATE
(
r_b
(
n
))
...
...
@@ -312,9 +313,7 @@ CONTAINS
ENDIF
!
! -> Collect the noco staff:
!
IF
(
noco
%
l_noco
.AND.
jspin
.EQ.
1
)
THEN
n
=
stars
%
ng3
...
...
@@ -347,9 +346,8 @@ CONTAINS
IF
(
noco
%
l_mperp
)
THEN
!
! --> for (spin)-off diagonal part of muffin-tin
!
n
=
(
atoms
%
lmaxd
+1
)
*
atoms
%
ntype
ALLOCATE
(
c_b
(
n
))
CALL
MPI_REDUCE
(
denCoeffsOffdiag
%
uu21
(:,:),
c_b
,
n
,
CPP_MPI_COMPLEX
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
...
...
@@ -369,9 +367,8 @@ CONTAINS
CALL
CPP_BLAS_ccopy
(
n
,
c_b
,
1
,
denCoeffsOffdiag
%
dd21
(:,:),
1
)
ENDIF
DEALLOCATE
(
c_b
)
!
! --> lo,u coeff's:
!
n
=
atoms
%
nlod
*
atoms
%
ntype
ALLOCATE
(
c_b
(
n
))
CALL
MPI_REDUCE
(
denCoeffsOffdiag
%
uulo21
(:,:),
c_b
,
n
,
CPP_MPI_COMPLEX
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
...
...
@@ -391,9 +388,8 @@ CONTAINS
CALL
CPP_BLAS_ccopy
(
n
,
c_b
,
1
,
denCoeffsOffdiag
%
ulod21
(:,:),
1
)
ENDIF
DEALLOCATE
(
c_b
)
!
! --> lo,lo' coeff's:
!
n
=
atoms
%
nlod
*
atoms
%
nlod
*
atoms
%
ntype
ALLOCATE
(
c_b
(
n
))
CALL
MPI_REDUCE
(
denCoeffsOffdiag
%
uloulop21
,
c_b
,
n
,
CPP_MPI_COMPLEX
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
...
...
@@ -403,9 +399,8 @@ CONTAINS
DEALLOCATE
(
c_b
)
IF
(
denCoeffsOffdiag
%
l_fmpl
)
THEN
!
!--> Full magnetization plots: Collect uunmt21, etc.
!
n
=
(
atoms
%
lmaxd
+1
)
**
2
*
sphhar
%
nlhd
*
atoms
%
ntype
ALLOCATE
(
c_b
(
n
))
CALL
MPI_REDUCE
(
denCoeffsOffdiag
%
uunmt21
,
c_b
,
n
,
CPP_MPI_COMPLEX
,
MPI_SUM
,
0
,
MPI_COMM_WORLD
,
ierr
)
...
...
types/types_dos.f90
View file @
bd99a389
...
...
@@ -11,6 +11,8 @@ IMPLICIT NONE
PRIVATE
TYPE
t_dos
INTEGER
,
ALLOCATABLE
::
jsym
(:,:,:)
INTEGER
,
ALLOCATABLE
::
ksym
(:,:,:)
REAL
,
ALLOCATABLE
::
qis
(:,:,:)
REAL
,
ALLOCATABLE
::
qal
(:,:,:,:,:)
REAL
,
ALLOCATABLE
::
qvac
(:,:,:,:)
...
...
@@ -39,12 +41,16 @@ SUBROUTINE dos_init(thisDOS,input,atoms,dimension,kpts,vacuum)
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
ALLOCATE
(
thisDOS
%
jsym
(
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisDOS
%
ksym
(
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisDOS
%
qis
(
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisDOS
%
qal
(
0
:
3
,
atoms
%
ntype
,
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisDOS
%
qvac
(
dimension
%
neigd
,
2
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisDOS
%
qvlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisDOS
%
qstars
(
vacuum
%
nstars
,
dimension
%
neigd
,
vacuum
%
layerd
,
2
,
kpts
%
nkpt
,
input
%
jspins
))
thisDOS
%
jsym
=
0
thisDOS
%
ksym
=
0
thisDOS
%
qis
=
0.0
thisDOS
%
qal
=
0.0
thisDOS
%
qvac
=
0.0
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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