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
ee533762
Commit
ee533762
authored
Apr 26, 2018
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop
parents
c3137481
c9a840fc
Changes
10
Hide whitespace changes
Inline
Side-by-side
Showing
10 changed files
with
114 additions
and
80 deletions
+114
-80
cdn/cdnval.F90
cdn/cdnval.F90
+9
-9
cdn/eparas.f90
cdn/eparas.f90
+8
-7
cdn/qal_21.f90
cdn/qal_21.f90
+6
-7
cdn/vacden.F90
cdn/vacden.F90
+10
-12
io/eig66_io.F90
io/eig66_io.F90
+12
-12
main/cdngen.F90
main/cdngen.F90
+4
-2
types/CMakeLists.txt
types/CMakeLists.txt
+2
-0
types/types.F90
types/types.F90
+1
-0
types/types_dos.f90
types/types_dos.f90
+56
-0
types/types_regionCharges.f90
types/types_regionCharges.f90
+6
-31
No files found.
cdn/cdnval.F90
View file @
ee533762
...
...
@@ -11,7 +11,7 @@ USE m_juDFT
CONTAINS
SUBROUTINE
cdnval
(
eig_id
,
mpi
,
kpts
,
jspin
,
sliceplot
,
noco
,
input
,
banddos
,
cell
,
atoms
,
enpara
,
stars
,&
vacuum
,
dimension
,
sphhar
,
sym
,
obsolete
,
vTot
,
oneD
,
coreSpecInput
,
cdnvalKLoop
,
den
,
regCharges
,
results
,&
vacuum
,
dimension
,
sphhar
,
sym
,
obsolete
,
vTot
,
oneD
,
coreSpecInput
,
cdnvalKLoop
,
den
,
regCharges
,
dos
,
results
,&
moments
,
mcd
,
slab
)
!************************************************************************************
...
...
@@ -76,6 +76,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
TYPE
(
t_cdnvalKLoop
),
INTENT
(
IN
)
::
cdnvalKLoop
TYPE
(
t_potden
),
INTENT
(
INOUT
)
::
den
TYPE
(
t_regionCharges
),
INTENT
(
INOUT
)
::
regCharges
TYPE
(
t_dos
),
INTENT
(
INOUT
)
::
dos
TYPE
(
t_moments
),
INTENT
(
INOUT
)
::
moments
TYPE
(
t_mcd
),
INTENT
(
INOUT
)
::
mcd
TYPE
(
t_slab
),
INTENT
(
INOUT
)
::
slab
...
...
@@ -212,7 +213,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
CALL
MPI_BARRIER
(
mpi
%
mpi_comm
,
iErr
)
! Synchronizes the RMA operations
#endif
IF
(
noccbd
.LE.
0
)
GO TO
199
! Note: This jump has to be after the MPI_BARRIER is called
IF
(
noccbd
.LE.
0
)
CYCLE
! Note: This jump has to be after the MPI_BARRIER is called
CALL
gVacMap
%
init
(
dimension
,
sym
,
atoms
,
vacuum
,
stars
,
lapw
,
input
,
cell
,
kpts
,
enpara
,
vTot
,
ikpt
,
jspin
)
...
...
@@ -220,17 +221,17 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
IF
(
.NOT.
((
jspin
.EQ.
2
)
.AND.
noco
%
l_noco
))
THEN
! valence density in the interstitial region
CALL
pwden
(
stars
,
kpts
,
banddos
,
oneD
,
input
,
mpi
,
noco
,
cell
,
atoms
,
sym
,
ikpt
,&
jspin
,
lapw
,
noccbd
,
we
,
eig
,
den
,
regCharge
s
%
qis
,
results
,
force
%
f_b8
,
zMat
)
jspin
,
lapw
,
noccbd
,
we
,
eig
,
den
,
do
s
%
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
)
! valence density in the vacuum region
IF
(
input
%
film
)
THEN
CALL
vacden
(
vacuum
,
dimension
,
stars
,
oneD
,
kpts
,
input
,
sym
,
cell
,
atoms
,
noco
,
banddos
,&
gVacMap
,
we
,
ikpt
,
jspin
,
vTot
%
vacz
(:,:,
jspin
),
noccbd
,
lapw
,
enpara
%
evac0
,
eig
,&
den
,
regCharges
%
qvac
,
regCharges
%
qvlay
,
regCharge
s
%
qstars
,
zMat
)
den
,
dos
%
qvac
,
dos
%
qvlay
,
do
s
%
qstars
,
zMat
)
END
IF
END
IF
IF
(
input
%
film
)
CALL
regCharges
%
sumBandsVac
(
vacuum
,
noccbd
,
ikpt
,
jsp_start
,
jsp_end
,
eig
,
we
)
IF
(
input
%
film
)
CALL
regCharges
%
sumBandsVac
(
vacuum
,
dos
,
noccbd
,
ikpt
,
jsp_start
,
jsp_end
,
eig
,
we
)
! valence density in the atomic spheres
CALL
eigVecCoeffs
%
init
(
dimension
,
atoms
,
noco
,
jspin
,
noccbd
)
...
...
@@ -244,9 +245,9 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
! perform Brillouin zone integration and summation over the
! bands in order to determine the energy parameters for each atom and angular momentum
CALL
eparas
(
ispin
,
atoms
,
noccbd
,
mpi
,
ikpt
,
noccbd
,
we
,
eig
,&
skip_t
,
cdnvalKLoop
%
l_evp
,
eigVecCoeffs
,
usdus
,
regCharges
,
mcd
,
banddos
%
l_mcd
)
skip_t
,
cdnvalKLoop
%
l_evp
,
eigVecCoeffs
,
usdus
,
regCharges
,
dos
,
mcd
,
banddos
%
l_mcd
)
IF
(
noco
%
l_mperp
.AND.
(
ispin
==
jsp_end
))
CALL
qal_21
(
dimension
,
atoms
,
input
,
noccbd
,
noco
,
eigVecCoeffs
,
denCoeffsOffdiag
,
regCharge
s
)
IF
(
noco
%
l_mperp
.AND.
(
ispin
==
jsp_end
))
CALL
qal_21
(
dimension
,
atoms
,
input
,
noccbd
,
noco
,
eigVecCoeffs
,
denCoeffsOffdiag
,
ikpt
,
do
s
)
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
IF
(
l_dosNdir
)
THEN
...
...
@@ -268,12 +269,11 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,sliceplot,noco, input,banddos,cell,atom
END
DO
! end loop over ispin
IF
(
noco
%
l_mperp
)
CALL
denCoeffsOffdiag
%
calcCoefficients
(
atoms
,
sphhar
,
sym
,
eigVecCoeffs
,
we
,
noccbd
)
199
CONTINUE
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
)
CALL
write_dos
(
eig_id
,
ikpt
,
jspin
,
regCharge
s
,
slab
,
orbcomp
,
ksym
,
jsym
,
mcd
%
mcd
)
CALL
write_dos
(
eig_id
,
ikpt
,
jspin
,
do
s
,
slab
,
orbcomp
,
ksym
,
jsym
,
mcd
%
mcd
)
END
IF
END
DO
! end of k-point loop
...
...
cdn/eparas.f90
View file @
ee533762
...
...
@@ -24,7 +24,7 @@ MODULE m_eparas
!
CONTAINS
SUBROUTINE
eparas
(
jsp
,
atoms
,
noccbd
,
mpi
,
ikpt
,
ne
,
we
,
eig
,
skip_t
,
l_evp
,
eigVecCoeffs
,&
usdus
,
regCharges
,
mcd
,
l_mcd
)
usdus
,
regCharges
,
dos
,
mcd
,
l_mcd
)
USE
m_types
IMPLICIT
NONE
TYPE
(
t_usdus
),
INTENT
(
IN
)
::
usdus
...
...
@@ -32,6 +32,7 @@ CONTAINS
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_eigVecCoeffs
),
INTENT
(
IN
)
::
eigVecCoeffs
TYPE
(
t_regionCharges
),
INTENT
(
INOUT
)
::
regCharges
TYPE
(
t_dos
),
INTENT
(
INOUT
)
::
dos
TYPE
(
t_mcd
),
INTENT
(
INOUT
)
::
mcd
! ..
! .. Scalar Arguments ..
...
...
@@ -64,9 +65,9 @@ CONTAINS
ENDIF
regCharges
%
ener
(:,:,
jsp
)
=
0.0
regCharges
%
sqal
(:,:,
jsp
)
=
0.0
regCharges
%
qal
(:,:,:,
jsp
)
=
0.0
regCharges
%
enerlo
(:,:,
jsp
)
=
0.0
regCharges
%
sqlo
(:,:,
jsp
)
=
0.0
dos
%
qal
(:,:,:,
ikpt
,
jsp
)
=
0.0
END
IF
!
!---> l-decomposed density for each occupied state
...
...
@@ -109,7 +110,7 @@ CONTAINS
ENDDO
ENDIF
! end MCD
ENDDO
regCharges
%
qal
(
l
,
n
,
i
,
jsp
)
=
(
suma
+
sumb
*
usdus
%
ddn
(
l
,
n
,
jsp
))/
atoms
%
neq
(
n
)
dos
%
qal
(
l
,
n
,
i
,
ikpt
,
jsp
)
=
(
suma
+
sumb
*
usdus
%
ddn
(
l
,
n
,
jsp
))/
atoms
%
neq
(
n
)
ENDDO
nt1
=
nt1
+
atoms
%
neq
(
n
)
ENDDO
...
...
@@ -122,8 +123,8 @@ CONTAINS
DO
l
=
0
,
3
DO
n
=
1
,
atoms
%
ntype
DO
i
=
(
skip_t
+1
),
noccbd
regCharges
%
ener
(
l
,
n
,
jsp
)
=
regCharges
%
ener
(
l
,
n
,
jsp
)
+
regCharges
%
qal
(
l
,
n
,
i
,
jsp
)
*
we
(
i
)
*
eig
(
i
)
regCharges
%
sqal
(
l
,
n
,
jsp
)
=
regCharges
%
sqal
(
l
,
n
,
jsp
)
+
regCharges
%
qal
(
l
,
n
,
i
,
jsp
)
*
we
(
i
)
regCharges
%
ener
(
l
,
n
,
jsp
)
=
regCharges
%
ener
(
l
,
n
,
jsp
)
+
dos
%
qal
(
l
,
n
,
i
,
ikpt
,
jsp
)
*
we
(
i
)
*
eig
(
i
)
regCharges
%
sqal
(
l
,
n
,
jsp
)
=
regCharges
%
sqal
(
l
,
n
,
jsp
)
+
dos
%
qal
(
l
,
n
,
i
,
ikpt
,
jsp
)
*
we
(
i
)
ENDDO
ENDDO
ENDDO
...
...
@@ -176,7 +177,7 @@ CONTAINS
! llo > 3 used for unoccupied states only
IF
(
l
.GT.
3
)
CYCLE
DO
i
=
1
,
ne
regCharges
%
qal
(
l
,
ntyp
,
i
,
jsp
)
=
regCharges
%
qal
(
l
,
ntyp
,
i
,
jsp
)
+
(
1.0
/
atoms
%
neq
(
ntyp
)
)
*
(&
dos
%
qal
(
l
,
ntyp
,
i
,
ikpt
,
jsp
)
=
dos
%
qal
(
l
,
ntyp
,
i
,
ikpt
,
jsp
)
+
(
1.0
/
atoms
%
neq
(
ntyp
)
)
*
(&
qaclo
(
i
,
lo
,
ntyp
)
*
usdus
%
uulon
(
lo
,
ntyp
,
jsp
)
+
qbclo
(
i
,
lo
,
ntyp
)
*
usdus
%
dulon
(
lo
,
ntyp
,
jsp
)
)
END
DO
DO
lop
=
1
,
atoms
%
nlo
(
ntyp
)
...
...
@@ -184,7 +185,7 @@ CONTAINS
DO
i
=
1
,
ne
regCharges
%
enerlo
(
lo
,
ntyp
,
jsp
)
=
regCharges
%
enerlo
(
lo
,
ntyp
,
jsp
)
+
qlo
(
i
,
lop
,
lo
,
ntyp
)
*
we
(
i
)
*
eig
(
i
)
regCharges
%
sqlo
(
lo
,
ntyp
,
jsp
)
=
regCharges
%
sqlo
(
lo
,
ntyp
,
jsp
)
+
qlo
(
i
,
lop
,
lo
,
ntyp
)
*
we
(
i
)
regCharges
%
qal
(
l
,
ntyp
,
i
,
jsp
)
=
regCharges
%
qal
(
l
,
ntyp
,
i
,
jsp
)
+
(
1.0
/
atoms
%
neq
(
ntyp
)
)
*
&
dos
%
qal
(
l
,
ntyp
,
i
,
ikpt
,
jsp
)
=
dos
%
qal
(
l
,
ntyp
,
i
,
ikpt
,
jsp
)
+
(
1.0
/
atoms
%
neq
(
ntyp
)
)
*
&
qlo
(
i
,
lop
,
lo
,
ntyp
)
*
usdus
%
uloulopn
(
lop
,
lo
,
ntyp
,
jsp
)
ENDDO
ENDIF
...
...
cdn/qal_21.f90
View file @
ee533762
...
...
@@ -5,7 +5,7 @@ MODULE m_qal21
!***********************************************************************
!
CONTAINS
SUBROUTINE
qal_21
(
dimension
,
atoms
,
input
,
noccbd
,
noco
,
eigVecCoeffs
,
denCoeffsOffdiag
,
regCharge
s
)
SUBROUTINE
qal_21
(
dimension
,
atoms
,
input
,
noccbd
,
noco
,
eigVecCoeffs
,
denCoeffsOffdiag
,
ikpt
,
do
s
)
USE
m_rotdenmat
USE
m_types
...
...
@@ -16,10 +16,10 @@ CONTAINS
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_eigVecCoeffs
),
INTENT
(
IN
)
::
eigVecCoeffs
TYPE
(
t_denCoeffsOffdiag
),
INTENT
(
IN
)
::
denCoeffsOffdiag
TYPE
(
t_
regionCharges
),
INTENT
(
INOUT
)
::
regCharge
s
TYPE
(
t_
dos
),
INTENT
(
INOUT
)
::
do
s
! .. Scalar Arguments ..
INTEGER
,
INTENT
(
IN
)
::
noccbd
INTEGER
,
INTENT
(
IN
)
::
noccbd
,
ikpt
! .. Local Scalars ..
INTEGER
i
,
l
,
lo
,
lop
,
natom
,
nn
,
ntyp
...
...
@@ -149,11 +149,10 @@ CONTAINS
state
:
DO
i
=
1
,
noccbd
lls
:
DO
l
=
0
,
3
CALL
rot_den_mat
(
noco
%
alph
(
n
),
noco
%
beta
(
n
),&
regCharges
%
qal
(
l
,
n
,
i
,
1
),
regCharges
%
qal
(
l
,
n
,
i
,
2
),
qal21
(
l
,
n
,
i
))
dos
%
qal
(
l
,
n
,
i
,
ikpt
,
1
),
dos
%
qal
(
l
,
n
,
i
,
ikpt
,
2
),
qal21
(
l
,
n
,
i
))
IF
(
.FALSE.
)
THEN
IF
(
n
==
1
)
WRITE
(
*
,
'(3i3,4f10.5)'
)
l
,
n
,
i
,
qal21
(
l
,
n
,
i
),&
regCharges
%
qal
(
l
,
n
,
i
,:)
q_loc
(
1
,
1
)
=
regCharges
%
qal
(
l
,
n
,
i
,
1
);
q_loc
(
2
,
2
)
=
regCharges
%
qal
(
l
,
n
,
i
,
2
)
IF
(
n
==
1
)
WRITE
(
*
,
'(3i3,4f10.5)'
)
l
,
n
,
i
,
qal21
(
l
,
n
,
i
),
dos
%
qal
(
l
,
n
,
i
,
ikpt
,:)
q_loc
(
1
,
1
)
=
dos
%
qal
(
l
,
n
,
i
,
ikpt
,
1
);
q_loc
(
2
,
2
)
=
dos
%
qal
(
l
,
n
,
i
,
ikpt
,
2
)
q_loc
(
1
,
2
)
=
qal21
(
l
,
n
,
i
);
q_loc
(
2
,
1
)
=
CONJG
(
q_loc
(
1
,
2
))
q_hlp
=
MATMUL
(
TRANSPOSE
(
CONJG
(
chi
)
)
,
q_loc
)
q_loc
=
MATMUL
(
q_hlp
,
chi
)
...
...
cdn/vacden.F90
View file @
ee533762
...
...
@@ -70,14 +70,14 @@ CONTAINS
INTEGER
,
PARAMETER
::
n2max
=
13
REAL
,
PARAMETER
::
emax
=
2.0
/
hartree_to_ev_const
! .. Array Arguments ..
REAL
,
INTENT
(
IN
)
::
evac
(
2
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
OUT
)
::
qvlay
(
DIMENSION
%
neigd
,
vacuum
%
layerd
,
2
,
kpts
%
nkpt
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
qvac
(
DIMENSION
%
neigd
,
2
,
kpts
%
nkpt
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
IN
)
::
we
(
DIMENSION
%
neigd
)
REAL
::
vz
(
vacuum
%
nmzd
,
2
)
! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
REAL
,
INTENT
(
IN
)
::
evac
(
2
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
OUT
)
::
qvlay
(
DIMENSION
%
neigd
,
vacuum
%
layerd
,
2
,
kpts
%
nkpt
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
INOUT
)
::
qvac
(
DIMENSION
%
neigd
,
2
,
kpts
%
nkpt
,
DIMENSION
%
jspd
)
REAL
,
INTENT
(
IN
)
::
we
(
DIMENSION
%
neigd
)
REAL
::
vz
(
vacuum
%
nmzd
,
2
)
! Note this breaks the INTENT(IN) from cdnval. It may be read from a file in this subroutine.
! STM-Arguments
REAL
,
INTENT
(
IN
)
::
eig
(
DIMENSION
%
neigd
)
COMPLEX
,
INTENT
(
OUT
)::
stcoeff
(
vacuum
%
nstars
,
DIMENSION
%
neigd
,
vacuum
%
layerd
,
2
)
REAL
,
INTENT
(
IN
)
::
eig
(
DIMENSION
%
neigd
)
COMPLEX
,
INTENT
(
INOUT
)
::
stcoeff
(
vacuum
%
nstars
,
DIMENSION
%
neigd
,
vacuum
%
layerd
,
2
,
kpts
%
nkpt
,
input
%
jspins
)
!
! local STM variables
INTEGER
nv2
(
DIMENSION
%
jspd
)
...
...
@@ -170,8 +170,6 @@ CONTAINS
! ------------------
! WRITE (16,'(a,i2)') 'nstars=',nstars
stcoeff
(:,:,:,:)
=
CMPLX
(
0.0
,
0.0
)
! -----> set up mapping arrays
IF
(
noco
%
l_ss
)
THEN
jsp_start
=
1
...
...
@@ -1198,7 +1196,7 @@ CONTAINS
!=============================================================
!
! calculate 1. to nstars. starcoefficient for each k and energy eigenvalue
! to stcoeff(ne,layer,ivac) if starcoeff=T (the star coefficient values are written to vacdos)
! to stcoeff(ne,layer,ivac
,ikpt
) if starcoeff=T (the star coefficient values are written to vacdos)
!
IF
(
vacuum
%
starcoeff
.AND.
banddos
%
vacdos
)
THEN
DO
n
=
1
,
ne
...
...
@@ -1229,9 +1227,9 @@ CONTAINS
uej
=
ue
(
vacuum
%
izlay
(
jj
,
1
),
l1
,
jspin
)
t1
=
aa
*
ui
*
uj
+
bb
*
uei
*
uej
+
ba
*
ui
*
uej
+
ab
*
uei
*
uj
IF
(
ind2
.GE.
2.
AND
.
ind2
.LE.
vacuum
%
nstars
)
&
stcoeff
(
ind2
-1
,
n
,
jj
,
ivac
)
=
stcoeff
(
ind2
-1
,
n
,
jj
,
ivac
)
+
t1
*
phs
/
stars
%
nstr2
(
ind2
)
stcoeff
(
ind2
-1
,
n
,
jj
,
ivac
,
ikpt
,
jspin
)
=
stcoeff
(
ind2
-1
,
n
,
jj
,
ivac
,
ikpt
,
jspin
)
+
t1
*
phs
/
stars
%
nstr2
(
ind2
)
IF
(
ind2p
.GE.
2.
AND
.
ind2p
.LE.
vacuum
%
nstars
)
&
stcoeff
(
ind2p
-1
,
n
,
jj
,
ivac
)
=
stcoeff
(
ind2p
-1
,
n
,
jj
,
ivac
)
+
CONJG
(
t1
)
*
phs
/
stars
%
nstr2
(
ind2p
)
stcoeff
(
ind2p
-1
,
n
,
jj
,
ivac
,
ikpt
,
jspin
)
=
stcoeff
(
ind2p
-1
,
n
,
jj
,
ivac
,
ikpt
,
jspin
)
+
CONJG
(
t1
)
*
phs
/
stars
%
nstr2
(
ind2p
)
END
DO
END
IF
ENDDO
...
...
io/eig66_io.F90
View file @
ee533762
...
...
@@ -167,7 +167,7 @@ CONTAINS
CALL
timestop
(
"IO (write)"
)
END
SUBROUTINE
write_eig
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
regCharge
s
,
slab
,
orbcomp
,
ksym
,
jsym
,
mcd
)
SUBROUTINE
write_dos
(
id
,
nk
,
jspin
,
do
s
,
slab
,
orbcomp
,
ksym
,
jsym
,
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,28 +175,28 @@ CONTAINS
USE
m_types
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
,
nk
,
jspin
TYPE
(
t_
regionCharges
),
INTENT
(
IN
)
::
regCharge
s
TYPE
(
t_orbcomp
),
INTENT
(
IN
)
::
orbcomp
TYPE
(
t_slab
),
INTENT
(
IN
)
::
slab
TYPE
(
t_
dos
),
INTENT
(
IN
)
::
do
s
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
,
regCharges
%
qal
(:,:,:,
jspin
),
regCharge
s
%
qvac
(:,:,
nk
,
jspin
),&
regCharges
%
qis
(:,
nk
,
jspin
),
regCharges
%
qvlay
(:,:,:,
nk
,
jspin
),
regCharges
%
qstars
,&
CALL
write_dos_DA
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
do
s
%
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
)
CASE
(
hdf_mode
)
CALL
write_dos_HDF
(
id
,
nk
,
jspin
,
regCharges
%
qal
(:,:,:,
jspin
),
regCharge
s
%
qvac
(:,:,
nk
,
jspin
),&
regCharges
%
qis
(:,
nk
,
jspin
),
regCharges
%
qvlay
(:,:,:,
nk
,
jspin
),
regCharges
%
qstars
,&
CALL
write_dos_HDF
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
do
s
%
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
)
CASE
(
mem_mode
)
CALL
write_dos_Mem
(
id
,
nk
,
jspin
,
regCharges
%
qal
(:,:,:,
jspin
),
regCharge
s
%
qvac
(:,:,
nk
,
jspin
),&
regCharges
%
qis
(:,
nk
,
jspin
),
regCharges
%
qvlay
(:,:,:,
nk
,
jspin
),
regCharges
%
qstars
,&
CALL
write_dos_Mem
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
do
s
%
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
)
CASE
(
MPI_mode
)
CALL
write_dos_MPI
(
id
,
nk
,
jspin
,
regCharges
%
qal
(:,:,:,
jspin
),
regCharge
s
%
qvac
(:,:,
nk
,
jspin
),&
regCharges
%
qis
(:,
nk
,
jspin
),
regCharges
%
qvlay
(:,:,:,
nk
,
jspin
),
regCharges
%
qstars
,&
CALL
write_dos_MPI
(
id
,
nk
,
jspin
,
dos
%
qal
(:,:,:,
nk
,
jspin
),
do
s
%
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
)
CASE
(
-1
)
CALL
juDFT_error
(
"Could not write DOS to eig-file before opening"
,
calledby
=
"eig66_io"
)
...
...
main/cdngen.F90
View file @
ee533762
...
...
@@ -70,6 +70,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
! Local type instances
TYPE
(
t_noco
)
::
noco_new
TYPE
(
t_regionCharges
)
::
regCharges
TYPE
(
t_dos
)
::
dos
TYPE
(
t_moments
)
::
moments
TYPE
(
t_mcd
)
::
mcd
TYPE
(
t_slab
)
::
slab
...
...
@@ -80,7 +81,8 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
REAL
::
fix
,
qtot
,
dummy
INTEGER
::
jspin
,
jspmax
CALL
regCharges
%
init
(
input
,
atoms
,
dimension
,
kpts
,
vacuum
)
CALL
regCharges
%
init
(
input
,
atoms
)
CALL
dos
%
init
(
input
,
atoms
,
dimension
,
kpts
,
vacuum
)
CALL
moments
%
init
(
input
,
atoms
)
IF
(
mpi
%
irank
.EQ.
0
)
CALL
openXMLElementNoAttributes
(
'valenceDensity'
)
...
...
@@ -94,7 +96,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
DO
jspin
=
1
,
jspmax
CALL
cdnvalKLoop
%
init
(
mpi
,
input
,
kpts
,
banddos
,
noco
,
results
,
jspin
,
sliceplot
)
CALL
cdnval
(
eig_id
,
mpi
,
kpts
,
jspin
,
sliceplot
,
noco
,
input
,
banddos
,
cell
,
atoms
,
enpara
,
stars
,
vacuum
,
dimension
,&
sphhar
,
sym
,
obsolete
,
vTot
,
oneD
,
coreSpecInput
,
cdnvalKLoop
,
outDen
,
regCharges
,
results
,
moments
,
mcd
,
slab
)
sphhar
,
sym
,
obsolete
,
vTot
,
oneD
,
coreSpecInput
,
cdnvalKLoop
,
outDen
,
regCharges
,
dos
,
results
,
moments
,
mcd
,
slab
)
END
DO
IF
(
mpi
%
irank
.EQ.
0
)
THEN
...
...
types/CMakeLists.txt
View file @
ee533762
...
...
@@ -18,6 +18,7 @@ types/types_usdus.F90
types/types_cdnval.f90
types/types_field.F90
types/types_regionCharges.f90
types/types_dos.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
...
...
@@ -40,6 +41,7 @@ types/types_setup.F90
types/types_usdus.F90
types/types_cdnval.f90
types/types_regionCharges.f90
types/types_dos.f90
types/types_denCoeffsOffdiag.f90
types/types_force.f90
)
types/types.F90
View file @
ee533762
...
...
@@ -22,6 +22,7 @@ MODULE m_types
USE
m_types_cdnval
USE
m_types_field
USE
m_types_regionCharges
USE
m_types_dos
USE
m_types_denCoeffsOffdiag
USE
m_types_force
END
MODULE
m_types
...
...
types/types_dos.f90
0 → 100644
View file @
ee533762
!--------------------------------------------------------------------------------
! Copyright (c) 2018 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE
m_types_dos
IMPLICIT
NONE
PRIVATE
TYPE
t_dos
REAL
,
ALLOCATABLE
::
qis
(:,:,:)
REAL
,
ALLOCATABLE
::
qal
(:,:,:,:,:)
REAL
,
ALLOCATABLE
::
qvac
(:,:,:,:)
REAL
,
ALLOCATABLE
::
qvlay
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
qstars
(:,:,:,:,:,:)
CONTAINS
PROCEDURE
,
PASS
::
init
=>
dos_init
END
TYPE
t_dos
PUBLIC
t_dos
CONTAINS
SUBROUTINE
dos_init
(
thisDOS
,
input
,
atoms
,
dimension
,
kpts
,
vacuum
)
USE
m_types_setup
USE
m_types_kpts
IMPLICIT
NONE
CLASS
(
t_dos
),
INTENT
(
INOUT
)
::
thisDOS
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
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
%
qis
=
0.0
thisDOS
%
qal
=
0.0
thisDOS
%
qvac
=
0.0
thisDOS
%
qvlay
=
0.0
thisDOS
%
qstars
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
dos_init
END
MODULE
m_types_dos
types/types_regionCharges.f90
View file @
ee533762
...
...
@@ -12,20 +12,12 @@ PRIVATE
TYPE
t_regionCharges
REAL
,
ALLOCATABLE
::
qis
(:,:,:)
REAL
,
ALLOCATABLE
::
qal
(:,:,:,:)
REAL
,
ALLOCATABLE
::
sqal
(:,:,:)
REAL
,
ALLOCATABLE
::
ener
(:,:,:)
REAL
,
ALLOCATABLE
::
sqlo
(:,:,:)
REAL
,
ALLOCATABLE
::
enerlo
(:,:,:)
REAL
,
ALLOCATABLE
::
qvac
(:,:,:,:)
REAL
,
ALLOCATABLE
::
svac
(:,:)
REAL
,
ALLOCATABLE
::
pvac
(:,:)
REAL
,
ALLOCATABLE
::
qvlay
(:,:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
qstars
(:,:,:,:)
CONTAINS
PROCEDURE
,
PASS
::
init
=>
regionCharges_init
...
...
@@ -36,60 +28,43 @@ PUBLIC t_regionCharges
CONTAINS
SUBROUTINE
regionCharges_init
(
thisRegCharges
,
input
,
atoms
,
dimension
,
kpts
,
vacuum
)
SUBROUTINE
regionCharges_init
(
thisRegCharges
,
input
,
atoms
)
USE
m_types_setup
USE
m_types_kpts
IMPLICIT
NONE
CLASS
(
t_regionCharges
),
INTENT
(
INOUT
)
::
thisRegCharges
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_dimension
),
INTENT
(
IN
)
::
dimension
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
ALLOCATE
(
thisRegCharges
%
qis
(
dimension
%
neigd
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
qal
(
0
:
3
,
atoms
%
ntype
,
dimension
%
neigd
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
sqal
(
0
:
3
,
atoms
%
ntype
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
ener
(
0
:
3
,
atoms
%
ntype
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
sqlo
(
atoms
%
nlod
,
atoms
%
ntype
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
enerlo
(
atoms
%
nlod
,
atoms
%
ntype
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
qvac
(
dimension
%
neigd
,
2
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
svac
(
2
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
pvac
(
2
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
qvlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
,
kpts
%
nkpt
,
input
%
jspins
))
ALLOCATE
(
thisRegCharges
%
qstars
(
vacuum
%
nstars
,
dimension
%
neigd
,
vacuum
%
layerd
,
2
))
thisRegCharges
%
qis
=
0.0
thisRegCharges
%
qal
=
0.0
thisRegCharges
%
sqal
=
0.0
thisRegCharges
%
ener
=
0.0
thisRegCharges
%
sqlo
=
0.0
thisRegCharges
%
enerlo
=
0.0
thisRegCharges
%
qvac
=
0.0
thisRegCharges
%
svac
=
0.0
thisRegCharges
%
pvac
=
0.0
thisRegCharges
%
qvlay
=
0.0
thisRegCharges
%
qstars
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
regionCharges_init
SUBROUTINE
sumBandsVac
(
thisRegCharges
,
vacuum
,
noccbd
,
ikpt
,
jsp_start
,
jsp_end
,
eig
,
we
)
SUBROUTINE
sumBandsVac
(
thisRegCharges
,
vacuum
,
dos
,
noccbd
,
ikpt
,
jsp_start
,
jsp_end
,
eig
,
we
)
USE
m_types_setup
USE
m_types_dos
IMPLICIT
NONE
CLASS
(
t_regionCharges
),
INTENT
(
INOUT
)
::
thisRegCharges
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_dos
),
INTENT
(
IN
)
::
dos
INTEGER
,
INTENT
(
IN
)
::
noccbd
INTEGER
,
INTENT
(
IN
)
::
ikpt
INTEGER
,
INTENT
(
IN
)
::
jsp_start
,
jsp_end
...
...
@@ -102,9 +77,9 @@ SUBROUTINE sumBandsVac(thisRegCharges,vacuum,noccbd,ikpt,jsp_start,jsp_end,eig,w
DO
ispin
=
jsp_start
,
jsp_end
DO
ivac
=
1
,
vacuum
%
nvac
thisRegCharges
%
pvac
(
ivac
,
ispin
)
=
thisRegCharges
%
pvac
(
ivac
,
ispin
)
+
&
dot_product
(
eig
(:
noccbd
)
*
thisRegCharge
s
%
qvac
(:
noccbd
,
ivac
,
ikpt
,
ispin
),
we
(:
noccbd
))
dot_product
(
eig
(:
noccbd
)
*
do
s
%
qvac
(:
noccbd
,
ivac
,
ikpt
,
ispin
),
we
(:
noccbd
))
thisRegCharges
%
svac
(
ivac
,
ispin
)
=
thisRegCharges
%
svac
(
ivac
,
ispin
)
+
&
dot_product
(
thisRegCharge
s
%
qvac
(:
noccbd
,
ivac
,
ikpt
,
ispin
),
we
(:
noccbd
))
dot_product
(
do
s
%
qvac
(:
noccbd
,
ivac
,
ikpt
,
ispin
),
we
(:
noccbd
))
END
DO
END
DO
...
...
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