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
b1dc7820
Commit
b1dc7820
authored
Jun 12, 2019
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
more modifications...
parent
6ae2e892
Changes
7
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
7 changed files
with
1222 additions
and
894 deletions
+1222
-894
inpgen/new/inpgen.f90
inpgen/new/inpgen.f90
+52
-25
inpgen/new/make_defaults.f90
inpgen/new/make_defaults.f90
+50
-65
inpgen/new/read_inpgen_input.f90
inpgen/new/read_inpgen_input.f90
+231
-62
kpoints/kptgen_hybrid.f
kpoints/kptgen_hybrid.f
+23
-28
kpoints/kptmop.f
kpoints/kptmop.f
+368
-604
kpoints/kpttet.f
kpoints/kpttet.f
+32
-93
types/types_kpts.f90
types/types_kpts.f90
+466
-17
No files found.
inpgen/new/inpgen.f90
View file @
b1dc7820
...
...
@@ -62,36 +62,63 @@ PROGRAM inpgen
!Start program and greet user
CALL
inpgen_help
()
!read the input
CALL
read_input
(
film
,
symor
,
atomid
,
atompos
,
atomlabel
,
amat
,
dvac
,
noco
)
!First we determine the spacegoup and map the atoms to groups
CALL
make_crystal
(
film
,
symor
,
atomid
,
atompos
,
atomlabel
,
amat
,
dvac
,
noco
,&
cell
,
sym
,
atoms
)
!All atom related parameters are set here. Note that some parameters might
!have been set in the read_input call before by adding defaults to the atompar module
CALL
make_atomic_defaults
(
input
,
vacuum
,
cell
,
oneD
,
atoms
)
INQUIRE
(
file
=
'inp.xml'
,
exist
=
l_inpxml
)
IF
(
l_inpxml
.AND..NOT.
judft_was_argument
(
"-inp.xml"
))
CALL
judft_error
(
"inp.xml exists and can not be overwritten"
)
IF
(
judft_was_argument
(
"-inp"
))
THEN
STOP
"not yet"
!CALL read_old_input()
full_input
=
.TRUE.
ELSEIF
(
judft_was_argument
(
"-inp.xml"
))
THEN
STOP
"not yet"
!CALL r_inpXML()
full_input
=
.TRUE.
ELSEIF
(
judft_was_argument
(
"-f"
))
THEN
!read the input
CALL
read_inpgen_input
(
atom_pos
,
atom_id
,
atom_label
,
amat
,
!Set all defaults that have not been specified before or can not be specified in inpgen
call
make_defaults
(
atoms
,
vacuum
,
input
,
stars
,
sliceplot
,
forcetheo
,
banddos
,&
cell
,
sym
,
xcpot
,
noco
,
oneD
,
hybrid
,
kpts
)
film
,
symor
,
atomid
,
atompos
,
atomlabel
,
amat
,
dvac
,
noco
)
full_input
=
.FALSE.
ELSE
CALL
judft_error
(
"You should either specify -inp,-inp.xml or -f command line options. Check -h if unsure"
)
ENDIF
IF
(
.NOT.
full_input
)
THEN
!First we determine the spacegoup and map the atoms to groups
CALL
make_crystal
(
film
,
symor
,
atomid
,
atompos
,
atomlabel
,
amat
,
dvac
,
noco
,&
cell
,
sym
,
atoms
)
!All atom related parameters are set here. Note that some parameters might
!have been set in the read_input call before by adding defaults to the atompar module
CALL
make_atomic_defaults
(
input
,
vacuum
,
cell
,
oneD
,
atoms
)
!Set all defaults that have not been specified before or can not be specified in inpgen
CALL
make_defaults
(
atoms
,
vacuum
,
input
,
stars
,
sliceplot
,
forcetheo
,
banddos
,&
cell
,
sym
,
xcpot
,
noco
,
oneD
,
hybrid
,
kpts
)
ENDIF
!
! k-points can also be modified here
!
call
make_kpoints
()
!
!Now the IO-section
!
!the inp.xml file
CALL
w_inpxml
(&
atoms
,
vacuum
,
input
,
stars
,
sliceplot
,
forcetheo
,
banddos
,&
cell
,
sym
,
xcpot
,
noco
,
oneD
,
hybrid
,
kpts
,&
div
,
l_gamma
,&
!should be in kpts!?
namex
,
relcor
,
dtild_opt
,
name_opt
,&
!?should be somewhere...
l_outFile
,
"inp.xml"
,&
l_explicit
,
enpara
)
!the sym.xml file
CALL
write_sym
()
IF
(
.NOT.
l_inpxml
)
THEN
!the inp.xml file
l_explicit
=
judft_was_argument
(
"-explicit"
)
CALL
dump_FleurInputSchema
()
CALL
w_inpxml
(&
atoms
,
vacuum
,
input
,
stars
,
sliceplot
,
forcetheo
,
banddos
,&
cell
,
sym
,
xcpot
,
noco
,
oneD
,
hybrid
,
kpts
,&
div
,
l_gamma
,&
!should be in kpts!?
namex
,
relcor
,
dtild_opt
,
name_opt
,&
!?should be somewhere...
.false.
,
"inp.xml"
,&
l_explicit
,
enpara
)
!the sym.xml file
CALL
sym
%
writeXML
(
0
,
"sym.xml"
)
ENDIF
CALL
kpts
%
writeXML
(
0
,
"kpts.xml"
)
! Structure in xsf-format
OPEN
(
55
,
file
=
"struct.xsf"
)
...
...
inpgen/new/make_defaults.f90
View file @
b1dc7820
...
...
@@ -36,14 +36,25 @@ CONTAINS
SUBROUTINE
make_defaults
(
atoms
,
vacuum
,
input
,
stars
,&
&
cell
,
sym
,
xcpot
,
noco
,
hybrid
,
kpts
)
SUBROUTINE
make_defaults
(
atoms
,
sym
,
vacuum
,
input
,
stars
,&
&
xcpot
,
noco
,
hybrid
)
USE
m_types
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_vacuum
),
INTENT
(
INOUT
)::
vacuum
TYPE
(
t_input
),
INTENT
(
INOUT
)
::
input
TYPE
(
t_stars
),
INTENT
(
INOUT
)
::
stars
TYPE
(
t_xcpot
),
INTENT
(
INOUT
)
::
xcpot
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco
TYPE
(
t_hybrid
),
INTENT
(
INOUT
)::
hybrid
IMPLICIT
NONE
!Set some more input switches
!
!input
!
input
%
delgau
=
input
%
tkb
IF
(
noco
%
l_noco
)
input
%
jspins
=
2
...
...
@@ -70,25 +81,47 @@ CONTAINS
input
%
rkmax
=
real
(
NINT
(
input
%
rkmax
*
10
)
/
10.
)
IF
(
noco
%
l_ss
)
input
%
ctail
=
.FALSE.
stars
%
gmax
=
merge
(
stars
%
gmax
,
3.0
*
input
%
rkmax
,
stars
%
gmax
>
0
)
stars
%
gmax
=
real
(
NINT
(
stars
%
gmax
*
10
)
/
10.
)
!
! stars
!
stars
%
gmax
=
merge
(
stars
%
gmax
,
3.0
*
input
%
rkmax
,
stars
%
gmax
>
0
)
stars
%
gmax
=
real
(
NINT
(
stars
%
gmax
*
10
)
/
10.
)
stars
%
gmaxInit
=
stars
%
gmax
xcpot
%
gmaxxc
=
merge
(
xcpot
%
gmaxxc
,
3.0
*
input
%
rkmax
,
xcpot
%
gmaxxc
>
0
)
!
!xcpot
!
xcpot
%
gmaxxc
=
merge
(
xcpot
%
gmaxxc
,
3.0
*
input
%
rkmax
,
xcpot
%
gmaxxc
>
0
)
xcpot
%
gmaxxc
=
real
(
NINT
(
xcpot
%
gmaxxc
*
10
)
/
10.
)
!
!vacuum
!
IF
(
.not.
input
%
film
)
THEN
vacuum
%
dvac
=
a3
(
3
)
Else
vacuum
%
dvac
=
real
(
NINT
(
vacuum
%
dvac
*
100
)/
100.
)
vacuum
%
dvac
=
REAL
(
NINT
(
vacuum
%
dvac
*
100
)/
100.
)
ENDIF
!
!HF added for HF and hybrid functionals
vacuum
%
nvac
=
2
IF
(
sym
%
zrfs
.OR.
sym
%
invs
)
vacuum
%
nvac
=
1
IF
(
oneD
%
odd
%
d1
)
vacuum
%
nvac
=
1
!
!noco
!
ALLOCATE
(
noco
%
l_relax
(
atoms
%
ntype
),
noco
%
b_con
(
2
,
atoms
%
ntype
))
ALLOCATE
(
noco
%
alphInit
(
atoms
%
ntype
),
noco
%
alph
(
atoms
%
ntype
),
noco
%
beta
(
atoms
%
ntype
))
noco
%
qss
=
MERGE
(
noco
%
qss
,[
0.0
,
0.0
,
0.0
],
noco
%
l_ss
)
noco
%
l_relax
(:)
=
.FALSE.
noco
%
alphInit
(:)
=
0.0
noco
%
alph
(:)
=
0.0
noco
%
beta
(:)
=
0.0
noco
%
b_con
(:,:)
=
0.0
!
!hybrid
!
hybrid
%
gcutm1
=
input
%
rkmax
-
0.5
ALLOCATE
(
hybrid
%
lcutwf
(
atoms
%
ntype
))
ALLOCATE
(
hybrid
%
lcutm1
(
atoms
%
ntype
))
...
...
@@ -101,55 +134,7 @@ CONTAINS
hybrid
%
select1
(
4
,:)
=
2
hybrid
%
l_hybrid
=
l_hyb
hybrid
%
gcutm1
=
real
(
NINT
(
hybrid
%
gcutm1
*
10
)
/
10.
)
! Set defaults for noco types
ALLOCATE
(
noco
%
l_relax
(
atoms
%
ntype
),
noco
%
b_con
(
2
,
atoms
%
ntype
))
ALLOCATE
(
noco
%
alphInit
(
atoms
%
ntype
),
noco
%
alph
(
atoms
%
ntype
),
noco
%
beta
(
atoms
%
ntype
))
noco
%
qss
=
merge
(
noco
%
qss
,[
0.0
,
0.0
,
0.0
],
noco
%
l_ss
)
noco
%
l_relax
(:)
=
.FALSE.
noco
%
alphInit
(:)
=
0.0
noco
%
alph
(:)
=
0.0
noco
%
beta
(:)
=
0.0
noco
%
b_con
(:,:)
=
0.0
! set vacuum%nvac
vacuum
%
nvac
=
2
IF
(
sym
%
zrfs
.OR.
sym
%
invs
)
vacuum
%
nvac
=
1
IF
(
oneD
%
odd
%
d1
)
vacuum
%
nvac
=
1
IF
(
l_hyb
)
THEN
! Changes for hybrid functionals
namex
=
'pbe0'
atoms
%
l_geo
=
.false.
! ; input%frcor = .true.
END
IF
l_explicit
=
juDFT_was_argument
(
"-explicit"
)
IF
(
l_explicit
)
THEN
! kpts generation
CALL
kpoints
(
oneD
,
sym
,
cell
,
input
,
noco
,
banddos
,
kpts
,
l_kpts
)
kpts
%
specificationType
=
3
kpts
%
l_gamma
=
.true.
IF
(
l_hyb
)
kpts
%
specificationType
=
2
END
IF
END
SUBROUTINE
make_defaults
END
MODULE
m_make_defaults
END
SUBROUTINE
make_defaults
END
MODULE
m_make_defaults
inpgen/new/read_inpgen_input.f90
View file @
b1dc7820
...
...
@@ -8,6 +8,7 @@ MODULE m_read_inpgen_input
USE
m_judft
IMPLICIT
NONE
CONTAINS
SUBROUTINE
read_inpgen_input
(
atom_pos
,
atom_id
,
atom_label
,
amat
,
div
,
namex
,
relcor
,
dtild
&
input
,
sym
,
noco
,
vacuum
,
stars
,
kpts
,
xcpot
,&
filename
)
...
...
@@ -45,77 +46,245 @@ CONTAINS
REAL
::
a1
(
3
),
a2
(
3
),
a3
(
3
),
SCALE
(
3
),
factor
(
3
),
aa
!lattice definition
INTEGER
::
infh
,
errfh
,
warnfh
,
dbgfh
,
outfh
,
symfh
!file handles
filename
=
juDFT_string_for_argument
(
"-f"
)
INQUIRE
(
file
=
filename
,
exist
=
l_exist
)
IF
(
.NOT.
l_exist
)
CALL
judft_error
(
"Input file specified is not readable"
)
ALLOCATE
(
mmrot
(
3
,
3
,
48
),
ttr
(
3
,
48
)
)
ALLOCATE
(
atompos
(
3
,
natmax
),
atomid
(
natmax
)
)
ALLOCATE
(
atomLabel
(
natmax
))
atomLabel
=
''
OPEN
(
97
,
file
=
filename
)
OPEN
(
98
,
status
=
'scratch'
)
OPEN
(
bfh
,
file
=
'bfh.txt'
,
form
=
'formatted'
,
status
=
'unknown'
)
IF
(
PRESENT
(
filename
))
OPEN
(
5
,
file
=
filename
)
noco
%
l_ss
=
.FALSE.
vacuum
%
dvac
=
0.0
noco
%
l_soc
=
.FALSE.
CALL
normalize_file
(
97
,
98
)
!default file handlers
infh
=
5
errfh
=
6
;
warnfh
=
6
;
dbgfh
=
6
;
outfh
=
6
;
symfh
=
97
REWIND
(
98
)
READ
(
98
,
"(a)"
,
iostat
=
ios
)
input
%
comment
namelist_ok
=
.TRUE.
DO
WHILE
(
ios
.NE.
0
)
READ
(
98
,
"(a)"
,
iostat
=
ios
)
line
IF
(
ios
.NE.
0
)
EXIT
IF
(
line
(
1
:
1
)
==
"&"
)
THEN
!process the namelist
SELECT
CASE
(
line
(
2
:
5
))
!e.g. atom
CASE
(
'latt'
)
CALL
process_lattice
(
line
,
cell
)
???
CASE
(
'inpu'
)
CALL
process_input
(
line
,
input
%
film
,
sym
%
symor
)
CASE
(
'qss '
)
CALL
process_qss
(
line
,
noco
)
CASE
(
'soc '
)
CALL
process_soc
(
line
,
noco
)
CASE
(
'shif'
)
CALL
process_shift
(
line
,
atom_pos
)
CASE
(
'fact'
)
CALL
process_factor
(
line
,
atom_pos
)
CASE
(
'exco'
)
CALL
process_exco
(
line
,
xcpot
)
CASE
(
'comp'
)
CALL
process_comp
(
line
,
input
%
jspins
,
input
%
frcor
,
input
%
ctail
,
input
%
kcrel
,
stars
%
gmax
,
xcpot
%
gmaxxc
,
input
%
rkmax
)
CASE
(
'kpt '
)
CALL
process_kpt
(
line
,
???
)
???
CASE
(
'film'
)
CALL
process_film
(
line
,
vacuum
%
dvac
,
vacuum
%
dtild
)
???
CASE
(
'gen '
,
'sym '
)
CALL
judft_error
(
"Specifying the symmetries no longer supported in inpgen"
)
CASE
default
CALL
judft_error
((
"Unkown input in:"
//
line
))
END
SELECT
ELSE
IF
(
SUM
(
ABS
(
cell
%
amat
))
>
0
)
THEN
!cell was set already, so list of atoms follow
READ
(
line
,
*
,
iostat
=
ios
)
n
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Surprising error in reading input:"
//
line
))
ALLOCATE
(
atom_pos
(
3
,
n
),
atom_label
(
n
),
atom_id
(
n
))
DO
i
=
1
,
n
READ
(
98
,
"(a)"
,
iostat
=
ios
)
line
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"List of atoms not complete:"
//
line
))
atom_id
(
i
)
=
evaluatefirst
(
line
)
atom_pos
(
1
,
i
)
=
evaluatefirst
(
line
)
atom_pos
(
2
,
i
)
=
evaluatefirst
(
line
)
atom_pos
(
3
,
i
)
=
evaluatefirst
(
line
)
IF
(
TRIM
(
ADJUSTL
(
line
))
.NE.
''
)
THEN
atom_Label
(
i
)
=
TRIM
(
ADJUSTL
(
line
))
ELSE
WRITE
(
atom_Label
(
i
),
'(i0)'
)
n
END
IF
END
DO
ELSE
!the bravais matrix has to follow
???
ENDIF
ENDIF
END
DO
IF
(
.NOT.
ALLOCATED
(
atompos
)
.OR.
SUM
(
ABS
(
cell
%
amat
))
==
0.0
)
CALL
judft_error
(
"input not complete"
)
nline
=
0
CALL
struct_input
(&
infh
,
errfh
,
warnfh
,
symfh
,
'sym '
,
bfh
,&
natmax
,
48
,&
nline
,
size
(
buffer
),
buffer
,&
title
,
input
%
film
,
cal_symm
,
checkinp
,
sym
%
symor
,&
cartesian
,
oldfleur
,
a1
,
a2
,
a3
,
vacuum
%
dvac
,
aa
,
scale
,
i_c
,&
factor
,
natin
,
atomid
,
atompos
,
ngen
,
mmrot
,
ttr
,
atomLabel
,&
l_hyb
,
noco
%
l_soc
,
noco
%
l_ss
,
noco
%
theta
,
noco
%
phi
,
noco
%
qss
,
inistop
)
!Check output
IF
(
.NOT.
cal_symm
)
CALL
judft_error
(
"Reading of symmetry no longer supported"
)
IF
(
checkinp
.OR.
inistop
)
CALL
judft_warn
(
"checkinp and inistop no longer supported"
)
IF
(
cartesian
)
CALL
judft_error
(
"Scaled Cartesian coordinates no longer supported"
)
IF
(
l_hyb
)
CALL
judft_warn
(
"Hybrid option no longer supported"
)
if
(
oldfleur
.and..not.
input
%
film
)
CALL
judft_warn
(
"oldfleur only in film setups"
)
!Generate amat
amat
(:,
1
)
=
aa
*
SCALE
(:)
*
a1
(:)
amat
(:,
2
)
=
aa
*
SCALE
(:)
*
a2
(:)
amat
(:,
3
)
=
aa
*
SCALE
(:)
*
a3
(:)
!Generate list of atoms
ALLOCATE
(
atom_pos
(
3
,
natin
),
atom_id
(
natin
),
atom_label
(
natin
))
atom_pos
=
atompos
(:,:
natin
)
atom_id
=
atomid
(:,:
natin
)
atom_label
=
atomlabel
(:,:
natin
)
!title
DO
i
=
1
,
10
j
=
(
i
-1
)
*
8
+
1
input
%
comment
(
i
)
=
title
(
j
:
j
+7
)
ENDDO
IF
(
.NOT.
input
%
film
)
vacuum
%
dvac
=
a3
(
3
)
dtild
=
0.0
input
%
l_inpXML
=
.TRUE.
END
SUBROUTINE
read_inpgen_input
SUBROUTINE
process_input
(
line
,
film
,
symor
,
hybrid
)
CHARACTER
(
len
=*
),
INTENT
(
in
)::
line
LOGICAL
,
INTENT
(
out
)::
film
,
symor
,
hybrid
INTEGER
::
ios
LOGICAL
::
cartesian
,
cal_symm
,
checkinp
,
inistop
,
oldfleur
cartesian
=
.FALSE.
cal_sym
=
.FALSE.
oldfleur
=
.FALSE.
NAMELIST
/
input
/
film
,
cartesian
,
cal_symm
,
checkinp
,
inistop
,
&
symor
,
oldfleur
,
hybrid
READ
(
line
,
input
,
iostat
=
ios
)
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Error reading:"
//
line
))
IF
(
ANY
([
cal_symm
,
checkinp
,
oldfleur
]))
CALL
judft_error
(
"Switches cal_symm, checkinp,oldfleur no longer supported"
)
END
SUBROUTINE
process_input
SUBROUTINE
process_qss
(
line
,
noco
)
CHARACTER
(
len
=*
),
INTENT
(
in
)::
line
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco
CHARACTER
(
len
=
1000
)
::
buf
buf
=
ADJUSTL
(
line
(
5
:
len_TRIM
(
line
)
-1
)
READ
(
line
,
*
,
iostat
=
ios
)
noco
%
qss
noco
%
l_ss
=
.TRUE.
noco
%
l_noco
=
.TRUE.
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Error reading:"
//
line
))
END
SUBROUTINE
process_qss
SUBROUTINE
process_soc
(
line
,
noco
)
CHARACTER
(
len
=*
),
INTENT
(
in
)::
line
TYPE
(
t_noco
),
INTENT
(
INOUT
)
::
noco
CHARACTER
(
len
=
1000
)
::
buf
buf
=
ADJUSTL
(
line
(
5
:
len_TRIM
(
line
)
-1
)
READ
(
line
,
*
,
iostat
=
ios
)
noco
%
theta
,
noco
%
phi
noco
%
l_soc
=
.TRUE.
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Error reading:"
//
line
))
END
SUBROUTINE
process_soc
SUBROUTINE
process_shift
(
line
,
atompos
)
CHARACTER
(
len
=*
),
INTENT
(
in
)::
line
REAL
,
INTENT
(
INOUT
)
::
atompos
(:,:)
CHARACTER
(
len
=
1000
)
::
buf
REAL
::
shift
(
3
)
INTEGER
::
ios
,
n
buf
=
ADJUSTL
(
line
(
7
:
len_TRIM
(
line
)
-1
)
READ
(
line
,
*
,
iostat
=
ios
)
shift
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Error reading:"
//
line
))
DO
n
=
1
,
SIZE
(
atompos
,
2
)
atompos
(:,
n
)
=
atompos
(:,)
+
shift
ENDDO
END
SUBROUTINE
process_shift
SUBROUTINE
process_factor
(
line
,
atompos
)
CHARACTER
(
len
=*
),
INTENT
(
in
)::
line
REAL
,
INTENT
(
INOUT
)
::
atompos
(:,:)
CHARACTER
(
len
=
1000
)
::
buf
REAL
::
factor
(
3
)
INTEGER
::
ios
,
n
buf
=
ADJUSTL
(
line
(
8
:
len_TRIM
(
line
)
-1
)
READ
(
line
,
*
,
iostat
=
ios
)
factor
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Error reading:"
//
line
))
DO
n
=
1
,
SIZE
(
atompos
,
2
)
atompos
(:,
n
)
=
atompos
(:,)/
factor
ENDDO
END
SUBROUTINE
process_factor
SUBROUTINE
process_exco
(
line
,
xcpot
)
CHARACTER
(
len
=*
),
INTENT
(
in
)::
line
TYPE
(
t_xcpot
),
INTENT
(
INOUT
)
::
xcpot
LOGICAL
::
relxc
CHARACTER
(
len
=
4
)
::
xctyp
NAMELIST
/
exco
/
xctyp
,
relxc
INTEGER
::
ios
READ
(
line
,
exco
,
iostat
=
ios
)
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Error reading:"
//
line
))
call
xcpot
???
END
SUBROUTINE
process_exco
SUBROUTINE
process_comp
(
line
,
jspins
,
frcor
,
ctail
,
kcrel
,
gmax
,
gmaxxc
,
rkmax
)
CHARACTER
(
len
=*
),
INTENT
(
in
)::
line
INTEGER
,
INTENT
(
inout
)::
jspins
,
frcor
,
ctail
,
kcrel
REAL
,
intent
(
inout
)
::
gmax
,
gmaxxc
,
rkmax
INTEGER
::
ios
NAMELIST
/
comp
/
jspins
,
frcor
,
ctail
,
kcrel
,
gmax
,
gmaxxc
,
kmax
READ
(
line
,
comp
,
iostat
=
ios
)
IF
(
ios
.NE.
0
)
CALL
judft_error
((
"Error reading:"
//
line
))
END
SUBROUTINE
process_comp
SUBROUTINE
normalize_file
(
infh
,
outfh
)
!***********************************************************************
! reads in the file from infh
! and:
! - deletes comments
! - deletes empty line
! - combines multiple line namelists into single line
!
! then the input is written to outfh
!
!***********************************************************************
CALL
lapw_input
(&
infh
,
nline
,
xl_buffer
,
bfh
,
buffer
,&
input
%
jspins
,
input
%
kcrel
,
obsolete
%
ndvgrd
,
kpts
%
nkpt
,
div
,
kpts
%
kPointDensity
,&
input
%
frcor
,
input
%
ctail
,
obsolete
%
chng
,
input
%
tria
,
input
%
rkmax
,
stars
%
gmax
,
xcpot
%
gmaxxc
,&
vacuum
%
dvac
,
dtild
,
input
%
tkb
,
namex
,
relcor
)
IMPLICIT
NONE
CLOSE
(
bfh
)
INTEGER
,
INTENT
(
IN
)
::
infh
! input filehandle (5)
INTEGER
,
INTENT
(
IN
)
::
outh
! Output filehandle
!Read the &atom namelists and put into atompar as default
s
C
ALL
read_params
(
"bfh.txt"
)
INTEGER
::
n
,
io
s
LOGICAL
::
building
,
complete
C
HARACTER
(
len
=
1000
)
::
line
,
buffer
OPEN
(
bfh
,
"bfh,txt"
)
CLOSE
(
bfh
,
status
=
'delete'
)
IF
(
PRESENT
(
filename
))
CLOSE
(
5
)
END
SUBROUTINE
read_inpgen_input
!---> initialize some variables
building
=
.false.
complete
=
.false.
loop
:
DO
READ
(
infh
,
'(a)'
,
IOSTAT
=
ios
)
line
IF
(
ios
.NE.
0
)
EXIT
!done
LINE
=
ADJUSTL
(
line
)
n
=
SCAN
(
line
,
'!'
)
! remove end of line comments
IF
(
n
>
0
)
THEN
line
=
line
(
1
:
n
-1
)
ENDIF
n
=
LEN_TRIM
(
line
)
! length of line without trailing blanks
IF
(
n
==
0
)
CYCLE
loop
IF
(
line
(
1
:
1
)
==
'&'
)
THEN
! check if beginning of namelist
IF
(
building
)
CALL
juDFT_error
(
"missing end of namelist marker / in or before line"
)
building
=
.TRUE.
buffer
=
line
IF
(
line
(
n
:
n
)
==
'/'
)
complete
=
.TRUE.
ELSEIF
(
line
(
n
:
n
)
==
'/'
)
THEN
! check if end of namelist
IF
(
building
)
THEN
complete
=
.TRUE.
buffer
=
trim
(
buffer
)//
' '
//
line
ELSE
CALL
juDFT_error
(
"out of place end of namelist marker / in line"
)
ENDIF
ELSEIF
(
building
)
THEN
! add line to buffer
buffer
=
trim
(
buffer
)//
' '
//
line
ELSEIF
(
n
>
0
)
THEN
! check for non empty lines outside of namelists
buffer
=
line
complete
=
.TRUE.
ENDIF
IF
(
complete
)
THEN
WRITE
(
outfh
,
"(a)"
)
TRIM
(
buffer
)
buffer
=
''
building
=
.FALSE.
complete
=
.FALSE.
END
IF
END
DO
loop
END
SUBROUTINE
normalize_file
END
MODULE
m_read_inpgen_input
kpoints/kptgen_hybrid.f
View file @
b1dc7820
...
...
@@ -16,17 +16,17 @@
!Modified for types D.W.
SUBROUTINE
kptgen_hybrid
(
input
,
cell
,
sym
,
kpts
,
l_soc
)
SUBROUTINE
kptgen_hybrid
(
film
,
grid
,
cell
,
sym
,
kpts
,
l_soc
)
USE
m_types
USE
m_divi
IMPLICIT
NONE
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
LOGICAL
,
INTENT
(
IN
)
::
film
INTEGER
,
INTENT
(
IN
)
::
grid
(
3
)
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_kpts
),
INTENT
(
INOUT
)
::
kpts
TYPE
(
t_kpts
),
INTENT
(
OUT
)
::
kpts
! - scalars -
LOGICAL
,
INTENT
(
IN
)
::
l_soc
! - local scalars -
...
...
@@ -44,21 +44,17 @@
REAL
,
ALLOCATABLE
::
rarr
(:)
LOGICAL
::
ldum
IF
(
sum
(
kpts
%
nkpt3
)
.EQ.
0
)
THEN
CALL
divi
(
kpts
%
nkpt
,
cell
%
bmat
,
input
%
film
,
sym
%
nop
,
&
sym
%
nop2
,
kpts
%
nkpt3
)
END
IF
nkpt
=
kpts
%
nkpt3
(
1
)
*
kpts
%
nkpt3
(
2
)
*
kpts
%
nkpt3
(
3
)
nkpt
=
grid
(
1
)
*
grid
(
2
)
*
grid
(
3
)
ALLOCATE
(
bk
(
3
,
nkpt
),
bkhlp
(
3
,
nkpt
)
)
ikpt
=
0
DO
i
=
0
,
kpts
%
nkpt3
(
1
)
-1
DO
j
=
0
,
kpts
%
nkpt3
(
2
)
-1
DO
k
=
0
,
kpts
%
nkpt3
(
3
)
-1
DO
i
=
0
,
grid
(
1
)
-1
DO
j
=
0
,
grid
(
2
)
-1
DO
k
=
0
,
grid
(
3
)
-1
ikpt
=
ikpt
+
1
bk
(:,
ikpt
)
=
(/
1.0
*
i
/
kpts
%
nkpt3
(
1
),
1.0
*
j
/
kpts
%
nkpt3
(
2
),
&
1.0
*
k
/
kpts
%
nkpt3
(
3
)
/)
bk
(:,
ikpt
)
=
(/
1.0
*
i
/
grid
(
1
),
1.0
*
j
/
grid
(
2
),
&
1.0
*
k
/
grid
(
3
)
/)
END
DO
END
DO
END
DO
...
...
@@ -113,16 +109,16 @@