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
1cde15db
Commit
1cde15db
authored
Oct 01, 2019
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Bugfixes
parent
ff0cec65
Changes
16
Hide whitespace changes
Inline
Side-by-side
Showing
16 changed files
with
209 additions
and
258 deletions
+209
-258
dos/evaldos.f90
dos/evaldos.f90
+35
-45
fermi/fermie.F90
fermi/fermie.F90
+7
-7
fermi/fertri.f
fermi/fertri.f
+8
-32
fleurinput/types_atoms.F90
fleurinput/types_atoms.F90
+3
-2
fleurinput/types_econfig.F90
fleurinput/types_econfig.F90
+40
-40
fleurinput/types_enparaXML.f90
fleurinput/types_enparaXML.f90
+4
-1
fleurinput/types_input.f90
fleurinput/types_input.f90
+2
-2
fleurinput/types_noco.f90
fleurinput/types_noco.f90
+14
-13
init/inpeig.f90
init/inpeig.f90
+10
-10
inpgen2/old_inp/rw_inp.f90
inpgen2/old_inp/rw_inp.f90
+4
-5
inpgen2/read_old_inp.f90
inpgen2/read_old_inp.f90
+30
-9
main/fleur_init.F90
main/fleur_init.F90
+2
-2
optional/stden.f90
optional/stden.f90
+3
-7
wannier/wann_get_kpts.f
wannier/wann_get_kpts.f
+2
-29
wannier/wann_mmnk_symm.f
wannier/wann_mmnk_symm.f
+31
-40
wannier/wann_read_inp.f90
wannier/wann_read_inp.f90
+14
-14
No files found.
dos/evaldos.f90
View file @
1cde15db
...
...
@@ -47,8 +47,8 @@
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
REAL
,
INTENT
(
IN
)
::
efermiarg
,
bandgap
LOGICAL
,
INTENT
(
IN
)
::
l_mcd
LOGICAL
,
INTENT
(
IN
)
::
l_mcd
! locals
INTEGER
,
PARAMETER
::
lmax
=
4
,
ned
=
1301
INTEGER
i
,
s
,
v
,
index
,
jspin
,
k
,
l
,
l1
,
l2
,
ln
,
n
,
nl
,
ntb
,
ntria
,
ntetra
...
...
@@ -73,7 +73,7 @@
qdim
=
lmax
*
atoms
%
ntype
+3
l_orbcomp
=
banddos
%
l_orb
IF
(
banddos
%
ndir
.EQ.
-3
)
THEN
qdim
=
2
*
slab
%
nsld
qdim
=
2
*
slab
%
nsld
n_orb
=
0
IF
(
banddos
%
l_orb
)
THEN
n_orb
=
banddos
%
orbCompAtom
...
...
@@ -84,7 +84,7 @@
ALLOCATE
(
qal
(
qdim
,
dimension
%
neigd
,
kpts
%
nkpt
),&
&
qval
(
vacuum
%
nstars
*
vacuum
%
layers
*
vacuum
%
nvac
,
dimension
%
neigd
,
kpts
%
nkpt
),&
&
qlay
(
dimension
%
neigd
,
vacuum
%
layerd
,
2
))
IF
(
l_mcd
)
THEN
IF
(
l_mcd
)
THEN
ALLOCATE
(
mcd_local
(
3
*
atoms
%
ntype
*
ncored
,
dimension
%
neigd
,
kpts
%
nkpt
)
)
ELSE
ALLOCATE
(
mcd_local
(
0
,
0
,
0
))
...
...
@@ -95,11 +95,11 @@
emin
=
min
(
banddos
%
e1_dos
*
hartree_to_ev_const
,
banddos
%
e2_dos
*
hartree_to_ev_const
)
emax
=
max
(
banddos
%
e1_dos
*
hartree_to_ev_const
,
banddos
%
e2_dos
*
hartree_to_ev_const
)
efermi
=
efermiarg
*
hartree_to_ev_const
WRITE
(
6
,
'(a)'
)
'DOS-Output is generated!'
IF
(
NINT
((
emax
-
emin
)/
sigma
)
>
ned
)
THEN
WRITE
(
6
,
*
)
'sig_dos too small for DOS smoothing:'
WRITE
(
6
,
*
)
'sig_dos too small for DOS smoothing:'
WRITE
(
6
,
*
)
'Reduce energy window or enlarge banddos%sig_dos!'
WRITE
(
6
,
*
)
'For now: setting sigma to zero !'
sigma
=
0.0
...
...
@@ -117,10 +117,10 @@
DO
i
=
1
,
ned
e
(
i
)
=
emin
+
(
i
-1
)
*
de
ENDDO
IF
(
l_mcd
)
THEN
! create an energy grid for mcd-spectra
e_lo
=
9.9
*
10.0
**
9
e_up
=
-9.9
*
10.0
**
9
e_lo
=
9.9
*
10.0
**
9
e_up
=
-9.9
*
10.0
**
9
DO
jspin
=
1
,
input
%
jspins
DO
n
=
1
,
atoms
%
ntype
DO
icore
=
1
,
mcd
%
ncore
(
n
)
...
...
@@ -129,7 +129,7 @@
ENDDO
ENDDO
ENDDO
e_lo
=
e_lo
*
hartree_to_ev_const
-
efermi
-
emax
e_lo
=
e_lo
*
hartree_to_ev_const
-
efermi
-
emax
e_up
=
e_up
*
hartree_to_ev_const
-
efermi
de
=
(
e_up
-
e_lo
)/(
ned
-1
)
DO
i
=
1
,
ned
...
...
@@ -207,7 +207,7 @@
qal
(
lmax
*
atoms
%
ntype
+1
,
i
,
k
)
=
qal
(
lmax
*
atoms
%
ntype
+1
,
i
,
k
)
-
qmt
ENDDO
qal
(
lmax
*
atoms
%
ntype
+1
,
i
,
k
)
=
qal
(
lmax
*
atoms
%
ntype
+1
,
i
,
k
)&
-
qal
(
lmax
*
atoms
%
ntype
+2
,
i
,
k
)
*
(
3
-
vacuum
%
nvac
)
-
qal
(
lmax
*
atoms
%
ntype
+3
,
i
,
k
)
*
(
vacuum
%
nvac
-1
)
-
qal
(
lmax
*
atoms
%
ntype
+2
,
i
,
k
)
*
(
3
-
vacuum
%
nvac
)
-
qal
(
lmax
*
atoms
%
ntype
+3
,
i
,
k
)
*
(
vacuum
%
nvac
-1
)
ENDDO
ENDIF
!
...
...
@@ -237,27 +237,17 @@
write
(
*
,
*
)
as
,
sym
%
nop2
,
l_tria
! l_tria=.true.
ELSE
IF
(
input
%
l_inpXML
)
THEN
IF
(
input
%
tria
)
THEN
ntetra
=
kpts
%
ntet
DO
i
=
1
,
ntetra
itetra
(
1
:
4
,
i
)
=
kpts
%
ntetra
(
1
:
4
,
i
)
voltet
(
i
)
=
kpts
%
voltet
(
i
)
/
ntetra
END
DO
l_tria
=
input
%
tria
GOTO
67
ELSE
GOTO
66
END
IF
IF
(
input
%
tria
)
THEN
ntetra
=
kpts
%
ntet
DO
i
=
1
,
ntetra
itetra
(
1
:
4
,
i
)
=
kpts
%
ntetra
(
1
:
4
,
i
)
voltet
(
i
)
=
kpts
%
voltet
(
i
)
/
ntetra
END
DO
l_tria
=
input
%
tria
GOTO
67
ELSE
GOTO
66
END
IF
OPEN
(
41
,
file
=
'kpts'
,
FORM
=
'formatted'
,
STATUS
=
'old'
)
DO
i
=
1
,
kpts
%
nkpt
+1
READ
(
41
,
*
,
END
=
66
,
ERR
=
66
)
ENDDO
READ
(
41
,
'(i5)'
,
END
=
66
,
ERR
=
66
)
ntetra
READ
(
41
,
'(4(4i6,4x))'
)
((
itetra
(
i
,
k
),
i
=
1
,
4
),
k
=
1
,
ntetra
)
READ
(
41
,
'(4f20.13)'
)
(
voltet
(
k
),
k
=
1
,
ntetra
)
CLOSE
(
41
)
voltet
(
1
:
ntetra
)
=
voltet
(
1
:
ntetra
)
/
ntetra
l_tria
=
.true.
GOTO
67
...
...
@@ -265,7 +255,7 @@
CALL
triang
(
kpts
%
bk
,
kpts
%
nkpt
,
itria
,
ntria
,
atr
,
as
,
l_tria
)
l_tria
=
.true.
! YM: tetrahedrons is not the way in 1D
IF
(
oneD
%
odi
%
d1
)
as
=
0.0
IF
(
oneD
%
odi
%
d1
)
as
=
0.0
IF
(
sym
%
invs
)
THEN
IF
(
abs
(
sym
%
nop2
*
as
-1.0
)
.GT.
0.000001
)
l_tria
=
.false.
ELSE
...
...
@@ -328,9 +318,9 @@
CALL
smooth
(
e
,
g
(
1
,
ln
),
sigma
,
ned
)
ENDDO
ENDIF
!*** sum up for all atoms
IF
(
banddos
%
ndir
.NE.
-3
)
THEN
DO
l
=
1
,
atoms
%
ntype
l1
=
lmax
*
(
l
-1
)
+
1
...
...
@@ -350,7 +340,7 @@
ENDDO
ENDDO
ENDIF
!**** write out DOS
OPEN
(
18
,
FILE
=
'DOS'
//
spin12
(
jspin
))
...
...
@@ -409,14 +399,14 @@
ENDDO
ENDDO
ENDDO
CLOSE
(
18
)
CLOSE
(
18
)
ENDIF
DEALLOCATE
(
g
)
!
!
!------------------------------------------------------------------------------
! now calculate the VACOS
!------------------------------------------------------------------------------
IF
(
banddos
%
vacdos
.and.
input
%
film
)
THEN
ALLOCATE
(
g
(
ned
,
vacuum
%
nstars
*
vacuum
%
layers
*
vacuum
%
nvac
))
! CALL ptdos(
...
...
@@ -425,16 +415,16 @@
! < g)
CALL
ptdos
(
emin
,
emax
,
input
%
jspins
,
ned
,
vacuum
%
nstars
*
vacuum
%
nvac
*
vacuum
%
layers
,
ntb
,
ntria
&
,
as
,
atr
,
2
*
kpts
%
nkpt
,
itria
,
kpts
%
nkpt
,
ev
(
1
:
ntb
,
1
:
kpts
%
nkpt
),
qval
(:,
1
:
ntb
,
1
:
kpts
%
nkpt
),
e
,
g
)
!---- > smoothening
IF
(
sigma
.GT.
0.0
)
THEN
DO
ln
=
1
,
vacuum
%
nstars
*
vacuum
%
nvac
*
vacuum
%
layers
CALL
smooth
(
e
,
g
(
1
,
ln
),
sigma
,
ned
)
ENDDO
ENDIF
! write VACDOS
OPEN
(
18
,
FILE
=
'VACDOS'
//
spin12
(
jspin
))
! WRITE (18,'(i2,25(2x,i3))') Layers , (Zlay(l),l=1,Layers)
DO
i
=
1
,
ned
...
...
@@ -464,11 +454,11 @@
END
IF
OPEN
(
18
,
FILE
=
'bands'
//
spin12
(
jspin
))
ntb
=
minval
(
results
%
neig
(:,
jspin
))
ntb
=
minval
(
results
%
neig
(:,
jspin
))
kx
(
1
)
=
0.0
vkr
(:,
1
)
=
matmul
(
kpts
%
bk
(:,
1
),
cell
%
bmat
)
DO
k
=
2
,
kpts
%
nkpt
vkr
(:,
k
)
=
matmul
(
kpts
%
bk
(:,
k
),
cell
%
bmat
)
dk
=
(
vkr
(
1
,
k
)
-
vkr
(
1
,
k
-1
))
**
2
+
(
vkr
(
2
,
k
)
-
vkr
(
2
,
k
-1
)
)
**
2
+
&
(
vkr
(
3
,
k
)
-
vkr
(
3
,
k
-1
))
**
2
...
...
@@ -483,7 +473,7 @@
ENDIF
ENDDO
!
!
!------------------------------------------------------------------------------
! for MCD calculations ...
!------------------------------------------------------------------------------
...
...
@@ -512,4 +502,4 @@
99001
FORMAT
(
f10.5
,
110
(
1x
,
e10.3
))
END
SUBROUTINE
evaldos
END
MODULE
m_evaldos
END
MODULE
m_evaldos
fermi/fermie.F90
View file @
1cde15db
...
...
@@ -80,11 +80,11 @@ CONTAINS
!***********************************************************************
! ABBREVIATIONS
!
! eig : array of eigenvalues
! eig : array of eigenvalues
! wtkpt : list of the weights of each k-point (from inp-file)
! e : linear list of the eigenvalues
! e : linear list of the eigenvalues
! we : list of weights of the eigenvalues in e
! zelec : number of electrons
! zelec : number of electrons
! spindg : spindegeneracy (2 in nonmagnetic calculations)
! seigv : weighted sum of the occupied valence eigenvalues
! seigsc : weighted sum of the semi-core eigenvalues
...
...
@@ -125,7 +125,7 @@ CONTAINS
IF
(
mpi
%
irank
==
0
)
THEN
CALL
read_eig
(
eig_id
,
k
,
jsp
,
neig
=
ne
(
k
,
jsp
),
eig
=
eig
(:,
k
,
jsp
))
WRITE
(
6
,
'(a2,3f10.5,f12.6)'
)
'at'
,
kpts
%
bk
(:,
k
),
kpts
%
wtkpt
(
k
)
WRITE
(
6
,
'(i5,a14)'
)
ne
(
k
,
jsp
),
' eigenvalues :'
WRITE
(
6
,
'(i5,a14)'
)
ne
(
k
,
jsp
),
' eigenvalues :'
WRITE
(
6
,
'(8f12.6)'
)
(
eig
(
i
,
k
,
jsp
),
i
=
1
,
ne
(
k
,
jsp
))
IF
(
.NOT.
judft_was_argument
(
"-minimalOutput"
))
THEN
attributes
=
''
...
...
@@ -144,7 +144,7 @@ CONTAINS
ENDDO
!finished reading of eigenvalues
IF
(
mpi
%
irank
==
0
)
CALL
closeXMLElement
(
'eigenvalues'
)
IF
(
mpi
%
irank
==
0
)
THEN
IF
(
mpi
%
irank
==
0
)
THEN
IF
(
ABS
(
input
%
fixed_moment
)
<
1E-6
)
THEN
!this is a standard calculation
...
...
@@ -167,7 +167,7 @@ CONTAINS
!Generate a list of energies
DO
k
=
1
,
kpts
%
nkpt
!
!---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE
!---> STORE EIGENVALUES AND WEIGHTS IN A LINEAR LIST. AND MEMORIZE
!---> CONECTION TO THE ORIGINAL ARRAYS
!
DO
j
=
1
,
ne
(
k
,
jsp
)
...
...
@@ -208,7 +208,7 @@ CONTAINS
IF
(
mpi
%
irank
==
0
)
THEN
WRITE
(
6
,
FMT
=
8010
)
n
,
ws
,
weight
END
IF
CALL
juDFT_error
(
"Not enough eavefunctions"
,
calledby
=
"fermie"
)
CALL
juDFT_error
(
"Not enough
w
eavefunctions"
,
calledby
=
"fermie"
)
8010
FORMAT
(
/
,
10x
,
'error: not enough wavefunctions.'
,
i10
,
2d20.10
)
END
IF
ws
=
ws
+
we
(
INDEX
(
l
))
...
...
fermi/fertri.f
View file @
1cde15db
...
...
@@ -86,38 +86,14 @@ c
c
--->
write
results
of
triang
IF
(
.not.
film
)
THEN
IF
(
input
%
l_inpXML
)
THEN
ntetra
=
kpts
%
ntet
DO
j
=
1
,
ntetra
itetra
(
1
:
4
,
j
)
=
kpts
%
ntetra
(
1
:
4
,
j
)
voltet
(
j
)
=
kpts
%
voltet
(
j
)
/
ntetra
END
DO
ELSE
IF
(
irank
==
0
)
THEN
WRITE
(
6
,
*
)
'reading tetrahedrons from file kpts'
END
IF
OPEN
(
41
,
file
=
'kpts'
,
FORM
=
'formatted'
,
STATUS
=
'old'
)
DO
i
=
1
,
nkpt
+1
READ
(
41
,
*
)
ENDDO
READ
(
41
,
'(i5)'
,
ERR
=
66
,
END
=
66
)
ntetra
IF
(
ntetra
>
6
*
nkpt
)
CALL
juDFT_error
(
"ntetra > 6 nkpt"
+
,
calledby
=
"fertri"
)
READ
(
41
,
'(4(4i6,4x))'
)
((
itetra
(
i
,
j
),
i
=
1
,
4
),
j
=
1
,
ntetra
)
READ
(
41
,
'(4f20.13)'
)
(
voltet
(
j
),
j
=
1
,
ntetra
)
voltet
(
1
:
ntetra
)
=
voltet
(
1
:
ntetra
)
/
ntetra
GOTO
67
66
CONTINUE
! no tetrahedron-information of file
CALL
make_tetra
(
>
nkpt
,
bk
,
ntria
,
itria
,
atr
,
<
ntetra
,
itetra
,
voltet
)
!keep
67
CONTINUE
! tetrahedron-information read or created
CLOSE
(
41
)
END
IF
lb
=
MINVAL
(
eig
(:,:,:))
-
0.01
ub
=
ef
+
0.2
CALL
tetra_ef
(
ntetra
=
kpts
%
ntet
DO
j
=
1
,
ntetra
itetra
(
1
:
4
,
j
)
=
kpts
%
ntetra
(
1
:
4
,
j
)
voltet
(
j
)
=
kpts
%
voltet
(
j
)
/
ntetra
END
DO
lb
=
MINVAL
(
eig
(:,:,:))
-
0.01
ub
=
ef
+
0.2
CALL
tetra_ef
(
>
jspins
,
nkpt
,
>
lb
,
ub
,
eig
,
zc
,
sfac
,
>
ntetra
,
itetra
,
voltet
,
...
...
fleurinput/types_atoms.F90
View file @
1cde15db
...
...
@@ -278,9 +278,10 @@ MODULE m_types_atoms
!force type
xpath
=
''
IF
(
xml
%
getNumberOfNodes
(
TRIM
(
ADJUSTL
(
xPaths
))//
'/force'
)
==
1
)
xpath
=
xpaths
IF
(
xml
%
getNumberOfNodes
(
TRIM
(
ADJUSTL
(
xPathg
))//
'/force'
)
==
1
)
xpath
=
xpathg
IF
(
xpath
.NE.
''
)
THEN
this
%
l_geo
(
n
)
=
evaluateFirstBoolOnly
(
xml
%
getAttributeValue
(
TRIM
(
ADJUSTL
(
xPath
g
))//
'/force/@calculate'
))
valueString
=
xml
%
getAttributeValue
(
TRIM
(
ADJUSTL
(
xPath
g
))//
'
force/@relaxXYZ'
)
this
%
l_geo
(
n
)
=
evaluateFirstBoolOnly
(
xml
%
getAttributeValue
(
TRIM
(
ADJUSTL
(
xPath
))//
'/force/@calculate'
))
valueString
=
xml
%
getAttributeValue
(
TRIM
(
ADJUSTL
(
xPath
))//
'/
force/@relaxXYZ'
)
READ
(
valueString
,
'(3l1)'
)
relaxX
,
relaxY
,
relaxZ
IF
(
relaxX
)
this
%
relax
(
1
,
n
)
=
1
IF
(
relaxY
)
this
%
relax
(
2
,
n
)
=
1
...
...
fleurinput/types_econfig.F90
View file @
1cde15db
...
...
@@ -9,7 +9,7 @@ MODULE m_types_econfig
PRIVATE
!This is used by t_atoms and does not extend t_fleurinput_base by itself
TYPE
::
t_econfig
CHARACTER
(
len
=
100
)
::
coreconfig
CHARACTER
(
len
=
200
)
::
coreconfig
CHARACTER
(
len
=
100
)
::
valenceconfig
INTEGER
::
num_core_states
INTEGER
::
num_states
...
...
@@ -29,7 +29,7 @@ MODULE m_types_econfig
END
TYPE
t_econfig
PUBLIC
::
t_econfig
CONTAINS
SUBROUTINE
get_core
(
econf
,
nst
,
nprnc
,
kappa
,
occupation
,
l_valence
)
CLASS
(
t_econfig
),
INTENT
(
IN
)
::
econf
INTEGER
,
INTENT
(
out
)
::
nst
...
...
@@ -46,9 +46,9 @@ CONTAINS
occupation
(:
nst
,:)
=
econf
%
occupation
(:
nst
,:)
if
(
size
(
occupation
,
2
)
==
1
)
occupation
=
occupation
*
2
END
SUBROUTINE
get_core
FUNCTION
get_state_string
(
econf
,
i
)
RESULT
(
str
)
CLASS
(
t_econfig
),
INTENT
(
IN
)::
econf
INTEGER
,
INTENT
(
in
)
::
i
...
...
@@ -74,17 +74,17 @@ CONTAINS
CASE
default
call
judft_error
(
"Invalid reqest for string with kappa"
)
END
SELECT
WRITE
(
str
,
"(a1,i1,a)"
)
"("
,
econf
%
nprnc
(
i
),
s
END
FUNCTION
get_state_string
SUBROUTINE
broadcast
(
econf
,
mpi_comm
)
USE
m_mpi_bc_tool
CLASS
(
t_econfig
),
INTENT
(
INOUT
)::
econf
INTEGER
,
INTENT
(
in
)
::
mpi_comm
#ifdef CPP_MPI
#ifdef CPP_MPI
INCLUDE
'mpif.h'
INTEGER
::
ierr
,
irank
...
...
@@ -97,7 +97,7 @@ CONTAINS
CALL
mpi_bc
(
econf
%
valence_electrons
,
0
,
mpi_comm
)
#endif
END
SUBROUTINE
broadcast
SUBROUTINE
init_num
(
econf
,
nc
,
nz
)
USE
m_constants
...
...
@@ -114,8 +114,8 @@ CONTAINS
CALL
econf
%
init
(
core
,
nz
)
END
SUBROUTINE
init_num
SUBROUTINE
init_simple
(
econf
,
str
)
CLASS
(
t_econfig
),
INTENT
(
OUT
)::
econf
CHARACTER
(
len
=*
),
INTENT
(
IN
)
::
str
...
...
@@ -123,10 +123,10 @@ CONTAINS
CHARACTER
(
len
=
200
)::
core
,
valence
INTEGER
::
n
REAL
,
allocatable
::
core_occ
(:),
valence_occ
(:)
n
=
INDEX
(
str
,
"|"
)
IF
(
n
==
0
)
CALL
judft_error
((
"Invalid econfig:"
//
TRIM
(
str
)))
IF
(
INDEX
(
str
,
"|"
)
==
1
)
THEN
! No core
core
=
""
...
...
@@ -157,15 +157,15 @@ CONTAINS
INTEGER
::
np
(
40
),
kap
(
40
)
econf
%
coreconfig
=
core
econf
%
valenceconfig
=
valence
CALL
expand_noble_gas
(
core
)
!extend noble gas config
IF
(
VERIFY
(
core
,
"(1234567spdf/) "
)
>
0
)
call
judft_error
((
"Invalid econfig:"
//
TRIM
(
core
)))
IF
(
VERIFY
(
valence
,
"(1234567spdf/) "
)
>
0
)
CALL
judft_error
((
"Invalid econfig:"
//
TRIM
(
valence
)))
econf
%
num_core_states
=
0
DO
WHILE
(
len_TRIM
(
core
)
>
1
)
CALL
extract_next
(
core
,
np
(
econf
%
num_core_states
+1
),
kap
(
econf
%
num_core_states
+1
))
...
...
@@ -180,7 +180,7 @@ CONTAINS
econf
%
nprnc
=
np
(:
econf
%
num_states
)
econf
%
kappa
=
kap
(:
econf
%
num_states
)
ALLOCATE
(
econf
%
occupation
(
econf
%
num_states
,
2
))
CALL
econf
%
set_occupation
(
"(1s1/2)"
,
-1.
,
-1.
)
END
SUBROUTINE
init_all
...
...
@@ -195,34 +195,34 @@ CONTAINS
CHARACTER
(
len
=
7
)::
str
IF
(
nz
>
54
)
CALL
judft_warn
(
"Specifying no explicit valence config for systems with f-states might lead to broken configs"
)
econf
%
coreconfig
=
core
CALL
expand_noble_gas
(
core
)
!extend noble gas config
IF
(
VERIFY
(
core
,
"(1234567spdf/) "
)
>
0
)
call
judft_error
((
"Invalid econfig:"
//
TRIM
(
core
)))
econf
%
num_core_states
=
0
DO
WHILE
(
len_TRIM
(
core
)
>
1
)
CALL
extract_next
(
core
,
np
(
econf
%
num_core_states
+1
),
kap
(
econf
%
num_core_states
+1
))
econf
%
num_core_states
=
econf
%
num_core_states
+1
ENDDO
econf
%
num_states
=
econf
%
num_core_states
!valence charge
charge
=
nz
-
SUM
(
ABS
(
kap
(:
econf
%
num_core_states
)))
*
2
DO
WHILE
(
charge
>
0
)
!Add valence
!valence charge
charge
=
nz
-
SUM
(
ABS
(
kap
(:
econf
%
num_core_states
))
**
2
)
*
2
DO
WHILE
(
charge
>
0
)
!Add valence
str
=
coreStateList_const
(
econf
%
num_states
+1
)
PRINT
*
,
econf
%
num_states
,
str
,
charge
CALL
extract_next
(
str
,
np
(
econf
%
num_states
+1
),
kap
(
econf
%
num_states
+1
))
econf
%
num_states
=
econf
%
num_states
+1
charge
=
charge
-
ABS
(
kap
(
econf
%
num_states
)
)
charge
=
charge
-
ABS
(
kap
(
econf
%
num_states
)
**
2
)
*
2
ENDDO
ALLOCATE
(
econf
%
nprnc
(
econf
%
num_states
),
econf
%
kappa
(
econf
%
num_states
))
econf
%
nprnc
=
np
(:
econf
%
num_states
)
econf
%
kappa
=
kap
(:
econf
%
num_states
)
ALLOCATE
(
econf
%
occupation
(
econf
%
num_states
,
2
))
CALL
econf
%
set_occupation
(
"(1s1/2)"
,
-1.
,
-1.
)
!last level might be partially occupied
IF
(
charge
<
0
)
THEN
...
...
@@ -241,9 +241,9 @@ CONTAINS
REAL
::
up
,
down
up
=
u
down
=
d
str
=
ADJUSTL
(
state
)
IF
(
up
==
-1.
.AND.
down
==
-1
)
THEN
!Set all defaults
econf
%
occupation
=
0.0
...
...
@@ -264,12 +264,12 @@ CONTAINS
up
=
-1
;
down
=
-1
END
IF
END
IF
END
DO
END
DO
END
IF
econf
%
core_electrons
=
SUM
(
econf
%
occupation
(:
econf
%
num_core_states
,:))
econf
%
valence_electrons
=
SUM
(
econf
%
occupation
(
econf
%
num_core_states
+1
:
econf
%
num_states
,:))
END
SUBROUTINE
set_occupation
SUBROUTINE
set_initial_moment
(
econf
,
bmu
)
CLASS
(
t_econfig
),
INTENT
(
INOUT
)::
econf
...
...
@@ -301,7 +301,7 @@ CONTAINS
SUBROUTINE
extract_next
(
str
,
n
,
kappa
)
CHARACTER
(
len
=*
),
INTENT
(
INOUT
)
::
str
INTEGER
,
INTENT
(
out
)
::
n
,
kappa
...
...
@@ -345,29 +345,29 @@ CONTAINS
CASE
(
"Ne"
,
"ne"
,
"NE"
)
str
=
"(1s1/2) (2s1/2) (2p1/2) "
//
str
CASE
(
"Ar"
,
"ar"
,
"AR"
)
str
=
"(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) "
//
str
str
=
"(1s1/2) (2s1/2) (2p1/2) (
2p3/2) (
3s1/2) (3p1/2) (3p3/2) "
//
str
CASE
(
"Kr"
,
"kr"
,
"KR"
)
str
=
"(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"
//
str
str
=
"(1s1/2) (2s1/2) (2p1/2) (
2p3/2) (
3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2)"
//
str
CASE
(
"Xe"
,
"xe"
,
"XE"
)
str
=
"(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) "
//
str
str
=
"(1s1/2) (2s1/2) (2p1/2) (
2p3/2) (
3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) "
//
str
CASE
(
"Rn"
,
"rn"
,
"RN"
)
str
=
"(1s1/2) (2s1/2) (2p1/2) (3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) (6s1/2) (4f5/2) (4f7/2) (5d3/2) (5d5/2) (6p1/2) (6p3/2) "
//
str
str
=
"(1s1/2) (2s1/2) (2p1/2) (
2p3/2) (
3s1/2) (3p1/2) (3p3/2) (4s1/2) (3d3/2) (3d5/2) (4p1/2) (4p3/2) (5s1/2) (4d3/2) (4d5/2) (5p1/2) (5p3/2) (6s1/2) (4f5/2) (4f7/2) (5d3/2) (5d5/2) (6p1/2) (6p3/2) "
//
str
CASE
default
call
judft_error
((
"Invalid econfig:"
//
TRIM
(
str
)))
END
SELECT
END
SUBROUTINE
expand_noble_gas
SUBROUTINE
convert_to_extended
(
simple
,
extended
,
occupations
)
CHARACTER
(
len
=*
),
INTENT
(
IN
)
::
simple
CHARACTER
(
len
=*
),
INTENT
(
OUT
)
::
extended
REAL
,
ALLOCATABLE
,
INTENT
(
OUT
)
::
occupations
(:)
CHARACTER
(
len
=
200
)::
conf
REAL
::
occupation
(
1
00
)
!this is the tmp local variable (no 's')
REAL
::
occupation
(
2
00
)
!this is the tmp local variable (no 's')
INTEGER
::
n
,
nn
,
occ
CHARACTER
::
n_ch
,
ch
extended
=
""
...
...
fleurinput/types_enparaXML.f90
View file @
1cde15db
...
...
@@ -131,7 +131,7 @@ CONTAINS
enpara
%
qn_el
(:,
ntype
,:)
=
ABS
(
enpara
%
qn_el
(:,
ntype
,:))
END
SUBROUTINE
set_quantum_numbers
SUBROUTINE
init
(
this
,
ntype
,
nlod
,
jspins
,
l_defaults
,
n
z
)
SUBROUTINE
Init
(
This
,
Ntype
,
Nlod
,
Jspins
,
L_defaults
,
N
z
)
USE
m_constants
CLASS
(
t_enparaXML
),
INTENT
(
inout
)::
this
INTEGER
,
INTENT
(
IN
)
::
jspins
,
nlod
,
ntype
...
...
@@ -141,6 +141,9 @@ CONTAINS
INTEGER
::
n
,
i
,
jsp
,
l
this
%
evac0
=
-1E99
if
(
allocated
(
this
%
qn_el
))
deallocate
(
this
%
qn_el
)
if
(
allocated
(
this
%
qn_ello
))
deallocate
(
this
%
qn_ello
)
ALLOCATE
(
this
%
qn_el
(
0
:
3
,
ntype
,
jspins
))
ALLOCATE
(
this
%
qn_ello
(
nlod
,
ntype
,
jspins
))
...
...
fleurinput/types_input.f90
View file @
1cde15db
...
...
@@ -57,7 +57,7 @@ MODULE m_types_input
LOGICAL
::
l_wann
=
.FALSE.
LOGICAL
::
secvar
=
.FALSE.
LOGICAL
::
evonly
=
.FALSE.
LOGICAL
::
l_inpXML
=
.TRUE.
!
LOGICAL:: l_inpXML=.TRUE.
REAL
::
ellow
=
-1.8
REAL
::
elup
=
1.0
REAL
::
fixed_moment
=
0.0
...
...
@@ -135,7 +135,7 @@ CONTAINS
call
mpi_bc
(
this
%
l_wann
,
rank
,
mpi_comm
)
call
mpi_bc
(
this
%
secvar
,
rank
,
mpi_comm
)
call
mpi_bc
(
this
%
evonly
,
rank
,
mpi_comm
)
call
mpi_bc
(
this
%
l_inpXML
,
rank
,
mpi_comm
)
!
call mpi_bc(this%l_inpXML,rank,mpi_comm)
call
mpi_bc
(
this
%
ellow
,
rank
,
mpi_comm
)
call
mpi_bc
(
this
%
elup
,
rank
,
mpi_comm
)
call
mpi_bc
(
this
%
fixed_moment
,
rank
,
mpi_comm
)
...
...
fleurinput/types_noco.f90
View file @
1cde15db
...
...
@@ -5,7 +5,7 @@
!--------------------------------------------------------------------------------
MODULE
m_types_noco
USE
m_judft
USE
m_judft
USE
m_types_fleurinput_base
IMPLICIT
NONE
PRIVATE
...
...
@@ -21,7 +21,7 @@ MODULE m_types_noco
LOGICAL
::
l_spav
=
.FALSE.
REAL
::
theta
=
0.0
REAL
::
phi
=
0.0
LOGICAL
,
ALLOCATABLE
::
l_relax
(:)
REAL
,
ALLOCATABLE
::
alphInit
(:)
REAL
,
ALLOCATABLE
::
alph
(:)
...
...
@@ -49,7 +49,7 @@ MODULE m_types_noco
ELSE
rank
=
0
END
IF
CALL
mpi_bc
(
this
%
l_ss
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
l_soc
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
l_noco
,
rank
,
mpi_comm
)
...
...
@@ -61,27 +61,27 @@ MODULE m_types_noco
CALL
mpi_bc
(
this
%
l_spav
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
theta
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
phi
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
l_relax
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
alphInit
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
alph
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
beta
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
b_con
,
rank
,
mpi_comm
)
CALL
mpi_bc
(
this
%
socscale
,
rank
,
mpi_comm
)