Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
54
Issues
54
List
Boards
Labels
Service Desk
Milestones
Operations
Operations
Incidents
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
ac883fe0
Commit
ac883fe0
authored
Feb 01, 2019
by
Matthias Redies
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
cleanup
parent
4013a001
Changes
2
Hide whitespace changes
Inline
Side-by-side
Showing
2 changed files
with
77 additions
and
93 deletions
+77
-93
main/cdngen.F90
main/cdngen.F90
+0
-1
xc-pot/metagga.F90
xc-pot/metagga.F90
+77
-92
No files found.
main/cdngen.F90
View file @
ac883fe0
...
@@ -231,7 +231,6 @@ subroutine save_kinED(xcpot, input, noco, stars, cell, sym)
...
@@ -231,7 +231,6 @@ subroutine save_kinED(xcpot, input, noco, stars, cell, sym)
use
m_types
use
m_types
use
m_pw_tofrom_grid
use
m_pw_tofrom_grid
use
m_judft_stop
use
m_judft_stop
use
m_metagga
,
only
:
give_stats
use
m_npy
use
m_npy
implicit
none
implicit
none
...
...
xc-pot/metagga.F90
View file @
ac883fe0
...
@@ -52,19 +52,6 @@ CONTAINS
...
@@ -52,19 +52,6 @@ CONTAINS
#endif
#endif
END
SUBROUTINE
calc_kinEnergyDen
END
SUBROUTINE
calc_kinEnergyDen
SUBROUTINE
give_stats
(
array
,
array_name
)
implicit
none
real
,
intent
(
in
)
::
array
(:,:)
character
(
len
=*
),
optional
::
array_name
write
(
*
,
*
)
"#############################"
if
(
present
(
array_name
))
write
(
*
,
*
)
"Array = "
,
array_name
write
(
*
,
'(A,ES17.10)'
)
"min = "
,
minval
(
array
)
write
(
*
,
'(A,ES17.10)'
)
"max = "
,
maxval
(
array
)
write
(
*
,
'(A,ES17.10)'
)
"mean = "
,
sum
(
array
)
/
size
(
array
)
write
(
*
,
*
)
"#############################"
END
SUBROUTINE
give_stats
SUBROUTINE
dump_array
(
array
,
filename
)
SUBROUTINE
dump_array
(
array
,
filename
)
implicit
none
implicit
none
real
,
intent
(
in
)
::
array
(:,:)
real
,
intent
(
in
)
::
array
(:,:)
...
@@ -160,7 +147,6 @@ CONTAINS
...
@@ -160,7 +147,6 @@ CONTAINS
INTEGER
,
INTENT
(
in
)
::
jspin
INTEGER
,
INTENT
(
in
)
::
jspin
TYPE
(
t_kpts
),
INTENT
(
in
)
::
kpts
TYPE
(
t_kpts
),
INTENT
(
in
)
::
kpts
REAL
,
INTENT
(
inout
)
::
f_ik
(:,:)
! f_ik(band_idx, kpt_idx)
REAL
,
INTENT
(
inout
)
::
f_ik
(:,:)
! f_ik(band_idx, kpt_idx)
REAL
,
allocatable
::
eigenvalues
(:,:)
! local vars
! local vars
REAL
::
e_i
(
SIZE
(
f_ik
,
dim
=
1
))
REAL
::
e_i
(
SIZE
(
f_ik
,
dim
=
1
))
...
@@ -168,7 +154,6 @@ CONTAINS
...
@@ -168,7 +154,6 @@ CONTAINS
DO
ikpt
=
1
,
kpts
%
nkpt
DO
ikpt
=
1
,
kpts
%
nkpt
CALL
read_eig
(
eig_id
,
ikpt
,
jspin
,
eig
=
e_i
)
CALL
read_eig
(
eig_id
,
ikpt
,
jspin
,
eig
=
e_i
)
eigenvalues
(:,
ikpt
)
=
e_i
f_ik
(:,
ikpt
)
=
f_ik
(:,
ikpt
)
*
e_i
f_ik
(:,
ikpt
)
=
f_ik
(:,
ikpt
)
*
e_i
ENDDO
ENDDO
END
SUBROUTINE
calc_EnergyDen_auxillary_weights
END
SUBROUTINE
calc_EnergyDen_auxillary_weights
...
@@ -307,20 +292,20 @@ CONTAINS
...
@@ -307,20 +292,20 @@ CONTAINS
IF
(
banddos
%
l_mcd
.AND..NOT.
PRESENT
(
mcd
))
CALL
juDFT_error
(
"mcd is missing"
,
calledby
=
"cdnval"
)
IF
(
banddos
%
l_mcd
.AND..NOT.
PRESENT
(
mcd
))
CALL
juDFT_error
(
"mcd is missing"
,
calledby
=
"cdnval"
)
! calculation of core spectra (EELS) initializations -start-
! calculation of core spectra (EELS) initializations -start-
l_coreSpec
=
.FALSE.
!
l_coreSpec = .FALSE.
IF
(
PRESENT
(
coreSpecInput
))
THEN
!
IF (PRESENT(coreSpecInput)) THEN
CALL
corespec_init
(
input
,
atoms
,
coreSpecInput
)
!
CALL corespec_init(input,atoms,coreSpecInput)
IF
(
l_cs
.AND.
(
mpi
%
isize
.NE.
1
))
CALL
juDFT_error
(
'EELS + MPI not implemented'
,
calledby
=
'cdnval'
)
!
IF(l_cs.AND.(mpi%isize.NE.1)) CALL juDFT_error('EELS + MPI not implemented', calledby = 'cdnval')
IF
(
l_cs
.AND.
jspin
.EQ.
1
)
CALL
corespec_gaunt
()
!
IF(l_cs.AND.jspin.EQ.1) CALL corespec_gaunt()
l_coreSpec
=
l_cs
!
l_coreSpec = l_cs
END
IF
!
END IF
! calculation of core spectra (EELS) initializations -end-
! calculation of core spectra (EELS) initializations -end-
IF
(
mpi
%
irank
==
0
)
THEN
!
IF (mpi%irank==0) THEN
WRITE
(
6
,
FMT
=
8000
)
jspin
!
WRITE (6,FMT=8000) jspin
WRITE
(
16
,
FMT
=
8000
)
jspin
!
WRITE (16,FMT=8000) jspin
CALL
openXMLElementPoly
(
'mtCharges'
,(/
'spin'
/),(/
jspin
/))
!
CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
END
IF
!
END IF
8000
FORMAT
(
/
,
/
,
10x
,
'valence density: spin='
,
i2
)
8000
FORMAT
(
/
,
/
,
10x
,
'valence density: spin='
,
i2
)
DO
iType
=
1
,
atoms
%
ntype
DO
iType
=
1
,
atoms
%
ntype
...
@@ -380,59 +365,58 @@ CONTAINS
...
@@ -380,59 +365,58 @@ CONTAINS
IF
(
.NOT.
((
jspin
.EQ.
2
)
.AND.
noco
%
l_noco
))
THEN
IF
(
.NOT.
((
jspin
.EQ.
2
)
.AND.
noco
%
l_noco
))
THEN
! valence density in the interstitial region
! valence density in the interstitial region
CALL
pwden
(
stars
,
kpts
,
banddos
,
oneD
,
input
,
mpi
,
noco
,
cell
,
atoms
,
sym
,
ikpt
,&
CALL
pwden
(
stars
,
kpts
,
banddos
,
oneD
,
input
,
mpi
,
noco
,
cell
,
atoms
,
sym
,
ikpt
,&
jspin
,
lapw
,
noccbd
,
we
,
eig
,
kinED
,
results
,
force
%
f_b8
,
z
Mat
,
dos
)
jspin
,
lapw
,
noccbd
,
we
,
eig
,
kinED
,
results
,
force
%
f_b8
,
z
Prime
,
dos
)
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
! charge of each valence state in this k-point of the SBZ in the layer interstitial region of the film
IF
(
l_dosNdir
.AND.
PRESENT
(
slab
))
CALL
q_int_sl
(
jspin
,
ikpt
,
stars
,
atoms
,
sym
,
cell
,
noccbd
,
lapw
,
slab
,
oneD
,
zMat
)
!
IF (l_dosNdir.AND.PRESENT(slab)) CALL q_int_sl(jspin,ikpt,stars,atoms,sym,cell,noccbd,lapw,slab,oneD,zMat)
! valence density in the vacuum region
!
!
valence density in the vacuum region
IF
(
input
%
film
)
THEN
!
IF (input%film) THEN
CALL
vacden
(
vacuum
,
dimension
,
stars
,
oneD
,
kpts
,
input
,
sym
,
cell
,
atoms
,
noco
,
banddos
,&
!
CALL vacden(vacuum,dimension,stars,oneD, kpts,input,sym,cell,atoms,noco,banddos,&
gVacMap
,
we
,
ikpt
,
jspin
,
vTot
%
vacz
(:,:,
jspin
),
noccbd
,
lapw
,
enpara
%
evac
,
eig
,
kinED
,
zMat
,
dos
)
!
gVacMap,we,ikpt,jspin,vTot%vacz(:,:,jspin),noccbd,lapw,enpara%evac,eig,kinED,zMat,dos)
END
IF
!
END IF
END
IF
END
IF
IF
(
input
%
film
)
CALL
regCharges
%
sumBandsVac
(
vacuum
,
dos
,
noccbd
,
ikpt
,
jsp_start
,
jsp_end
,
eig
,
we
)
! valence density in the atomic spheres
! valence density in the atomic spheres
CALL
eigVecCoeffs
%
init
(
input
,
DIMENSION
,
atoms
,
noco
,
jspin
,
noccbd
)
!
CALL eigVecCoeffs%init(input,DIMENSION,atoms,noco,jspin,noccbd)
DO
ispin
=
jsp_start
,
jsp_end
!
DO ispin = jsp_start, jsp_end
IF
(
input
%
l_f
)
CALL
force
%
init2
(
noccbd
,
input
,
atoms
)
!
IF (input%l_f) CALL force%init2(noccbd,input,atoms)
CALL
abcof
(
input
,
atoms
,
sym
,
cell
,
lapw
,
noccbd
,
usdus
,
noco
,
ispin
,
oneD
,&
!
CALL abcof(input,atoms,sym,cell,lapw,noccbd,usdus,noco,ispin,oneD,&
eigVecCoeffs
%
acof
(:,
0
:,:,
ispin
),
eigVecCoeffs
%
bcof
(:,
0
:,:,
ispin
),&
!
eigVecCoeffs%acof(:,0:,:,ispin),eigVecCoeffs%bcof(:,0:,:,ispin),&
eigVecCoeffs
%
ccof
(
-
atoms
%
llod
:,:,:,:,
ispin
),
zMat
,
eig
,
force
)
!
eigVecCoeffs%ccof(-atoms%llod:,:,:,:,ispin),zMat,eig,force)
IF
(
atoms
%
n_u
.GT.
0
)
CALL
n_mat
(
atoms
,
sym
,
noccbd
,
usdus
,
ispin
,
we
,
eigVecCoeffs
,
kinED
%
mmpMat
(:,:,:,
jspin
))
!
IF (atoms%n_u.GT.0) CALL n_mat(atoms,sym,noccbd,usdus,ispin,we,eigVecCoeffs,kinED%mmpMat(:,:,:,jspin))
! perform Brillouin zone integration and summation over the
!
!
perform Brillouin zone integration and summation over the
! bands in order to determine the energy parameters for each atom and angular momentum
!
!
bands in order to determine the energy parameters for each atom and angular momentum
CALL
eparas
(
ispin
,
atoms
,
noccbd
,
mpi
,
ikpt
,
noccbd
,
we
,
eig
,&
!
CALL eparas(ispin,atoms,noccbd,mpi,ikpt,noccbd,we,eig,&
skip_t
,
cdnvalJob
%
l_evp
,
eigVecCoeffs
,
usdus
,
regCharges
,
dos
,
banddos
%
l_mcd
,
mcd
)
!
skip_t,cdnvalJob%l_evp,eigVecCoeffs,usdus,regCharges,dos,banddos%l_mcd,mcd)
IF
(
noco
%
l_mperp
.AND.
(
ispin
==
jsp_end
))
THEN
!
IF (noco%l_mperp.AND.(ispin==jsp_end)) THEN
CALL
qal_21
(
dimension
,
atoms
,
input
,
noccbd
,
noco
,
eigVecCoeffs
,
denCoeffsOffdiag
,
ikpt
,
dos
)
!
CALL qal_21(dimension,atoms,input,noccbd,noco,eigVecCoeffs,denCoeffsOffdiag,ikpt,dos)
ENDIF
!
ENDIF
! layer charge of each valence state in this k-point of the SBZ from the mt-sphere region of the film
!
!
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
!
IF (l_dosNdir) THEN
IF
(
PRESENT
(
slab
))
CALL
q_mt_sl
(
ispin
,
atoms
,
noccbd
,
ikpt
,
noccbd
,
skip_t
,
noccbd
,
eigVecCoeffs
,
usdus
,
slab
)
!
IF (PRESENT(slab)) CALL q_mt_sl(ispin,atoms,noccbd,ikpt,noccbd,skip_t,noccbd,eigVecCoeffs,usdus,slab)
INQUIRE
(
file
=
'orbcomprot'
,
exist
=
l_orbcomprot
)
!
INQUIRE (file='orbcomprot',exist=l_orbcomprot)
IF
(
l_orbcomprot
)
CALL
abcrot2
(
atoms
,
noccbd
,
eigVecCoeffs
,
ispin
)
! rotate ab-coeffs
!
IF (l_orbcomprot) CALL abcrot2(atoms,noccbd,eigVecCoeffs,ispin) ! rotate ab-coeffs
IF
(
PRESENT
(
orbcomp
))
CALL
orb_comp
(
ispin
,
ikpt
,
noccbd
,
atoms
,
noccbd
,
usdus
,
eigVecCoeffs
,
orbcomp
)
!
IF (PRESENT(orbcomp)) CALL orb_comp(ispin,ikpt,noccbd,atoms,noccbd,usdus,eigVecCoeffs,orbcomp)
END
IF
!
END IF
CALL
calcDenCoeffs
(
atoms
,
sphhar
,
sym
,
we
,
noccbd
,
eigVecCoeffs
,
ispin
,
denCoeffs
)
!
CALL calcDenCoeffs(atoms,sphhar,sym,we,noccbd,eigVecCoeffs,ispin,denCoeffs)
IF
(
noco
%
l_soc
)
CALL
orbmom
(
atoms
,
noccbd
,
we
,
ispin
,
eigVecCoeffs
,
orb
)
!
IF (noco%l_soc) CALL orbmom(atoms,noccbd,we,ispin,eigVecCoeffs,orb)
IF
(
input
%
l_f
)
CALL
force
%
addContribsA21A12
(
input
,
atoms
,
dimension
,
sym
,
cell
,
oneD
,
enpara
,&
!
IF (input%l_f) CALL force%addContribsA21A12(input,atoms,dimension,sym,cell,oneD,enpara,&
usdus
,
eigVecCoeffs
,
noccbd
,
ispin
,
eig
,
we
,
results
)
!
usdus,eigVecCoeffs,noccbd,ispin,eig,we,results)
IF
(
l_coreSpec
)
CALL
corespec_dos
(
atoms
,
usdus
,
ispin
,
dimension
%
lmd
,
kpts
%
nkpt
,
ikpt
,
dimension
%
neigd
,&
!
IF(l_coreSpec) CALL corespec_dos(atoms,usdus,ispin,dimension%lmd,kpts%nkpt,ikpt,dimension%neigd,&
noccbd
,
results
%
ef
,
banddos
%
sig_dos
,
eig
,
we
,
eigVecCoeffs
)
!
noccbd,results%ef,banddos%sig_dos,eig,we,eigVecCoeffs)
END
DO
! end loop over ispin
!
END DO ! end loop over ispin
IF
(
noco
%
l_mperp
)
CALL
denCoeffsOffdiag
%
calcCoefficients
(
atoms
,
sphhar
,
sym
,
eigVecCoeffs
,
we
,
noccbd
)
!
IF (noco%l_mperp) CALL denCoeffsOffdiag%calcCoefficients(atoms,sphhar,sym,eigVecCoeffs,we,noccbd)
IF
((
banddos
%
dos
.OR.
banddos
%
vacdos
.OR.
input
%
cdinf
)
.AND.
(
banddos
%
ndir
.GT.
0
))
THEN
!
IF ((banddos%dos.OR.banddos%vacdos.OR.input%cdinf).AND.(banddos%ndir.GT.0)) THEN
! since z is no longer an argument of cdninf sympsi has to be called here!
!
!
since z is no longer an argument of cdninf sympsi has to be called here!
CALL
sympsi
(
lapw
,
jspin
,
sym
,
dimension
,
nbands
,
cell
,
eig
,
noco
,
dos
%
ksym
(:,
ikpt
,
jspin
),
dos
%
jsym
(:,
ikpt
,
jspin
),
zMat
)
!
CALL sympsi(lapw,jspin,sym,dimension,nbands,cell,eig,noco,dos%ksym(:,ikpt,jspin),dos%jsym(:,ikpt,jspin),zMat)
END
IF
!
END IF
END
DO
! end of k-point loop
END
DO
! end of k-point loop
#ifdef CPP_MPI
#ifdef CPP_MPI
...
@@ -442,26 +426,27 @@ CONTAINS
...
@@ -442,26 +426,27 @@ CONTAINS
END
DO
END
DO
#endif
#endif
IF
(
mpi
%
irank
==
0
)
THEN
!
IF (mpi%irank==0) THEN
CALL
cdnmt
(
mpi
,
input
%
jspins
,
atoms
,
sphhar
,
noco
,
jsp_start
,
jsp_end
,&
!
CALL cdnmt(mpi, input%jspins,atoms,sphhar,noco,jsp_start,jsp_end,&
enpara
,
vTot
%
mt
(:,
0
,:,:),
denCoeffs
,
usdus
,
orb
,
denCoeffsOffdiag
,
moments
,
kinED
%
mt
)
!
enpara,vTot%mt(:,0,:,:),denCoeffs,usdus,orb,denCoeffsOffdiag,moments,kinED%mt)
IF
(
l_coreSpec
)
CALL
corespec_ddscs
(
jspin
,
input
%
jspins
)
!
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
DO
ispin
=
jsp_start
,
jsp_end
!
DO ispin = jsp_start,jsp_end
IF
(
input
%
cdinf
)
THEN
!
IF (input%cdinf) THEN
WRITE
(
6
,
FMT
=
8210
)
ispin
!
WRITE (6,FMT=8210) ispin
8210
FORMAT
(
/
,
5x
,
'check continuity of cdn for spin='
,
i2
)
!
8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
CALL
checkDOPAll
(
input
,
dimension
,
sphhar
,
stars
,
atoms
,
sym
,
vacuum
,
oneD
,
cell
,
kinED
,
ispin
)
!
CALL checkDOPAll(input,dimension,sphhar,stars,atoms,sym,vacuum,oneD,cell,kinED,ispin)
END
IF
!
END IF
IF
(
input
%
l_f
)
CALL
force_a8
(
input
,
atoms
,
sphhar
,
ispin
,
vTot
%
mt
(:,:,:,
ispin
),
kinED
%
mt
,
force
,
results
)
!
IF (input%l_f) CALL force_a8(input,atoms,sphhar,ispin,vTot%mt(:,:,:,ispin),kinED%mt,force,results)
END
DO
!
END DO
CALL
closeXMLElement
(
'mtCharges'
)
!
CALL closeXMLElement('mtCharges')
END
IF
!
END IF
CALL
timestop
(
"cdnval"
)
CALL
timestop
(
"cdnval"
)
END
SUBROUTINE
calc_kinED_pw
END
SUBROUTINE
calc_kinED_pw
subroutine
set_zPrime
(
dim_idx
,
zMat
,
kpt
,
lapw
,
cell
,
zPrime
)
subroutine
set_zPrime
(
dim_idx
,
zMat
,
kpt
,
lapw
,
cell
,
zPrime
)
USE
m_types
USE
m_types
USE
m_constants
implicit
none
implicit
none
INTEGER
,
intent
(
in
)
::
dim_idx
INTEGER
,
intent
(
in
)
::
dim_idx
TYPE
(
t_mat
),
intent
(
in
)
::
zMat
TYPE
(
t_mat
),
intent
(
in
)
::
zMat
...
@@ -482,9 +467,9 @@ CONTAINS
...
@@ -482,9 +467,9 @@ CONTAINS
fac
=
k_plus_g
(
dim_idx
)
fac
=
k_plus_g
(
dim_idx
)
if
(
zPrime
%
l_real
)
then
if
(
zPrime
%
l_real
)
then
zPrime
%
data_r
(
basis_idx
,:)
=
fac
*
zPrime
%
data_r
(
basis_idx
,:)
zPrime
%
data_r
(
basis_idx
,:)
=
fac
*
zMat
%
data_r
(
basis_idx
,:)
else
else
zPrime
%
data_c
(
basis_idx
,:)
=
fac
*
zPrime
%
data_c
(
basis_idx
,:)
zPrime
%
data_c
(
basis_idx
,:)
=
ImagUnit
*
fac
*
zMat
%
data_c
(
basis_idx
,:)
endif
endif
enddo
enddo
end
subroutine
set_zPrime
end
subroutine
set_zPrime
...
...
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