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
f10fd0f8
Commit
f10fd0f8
authored
Jun 27, 2017
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
More fixes...
parent
597e7658
Changes
12
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
12 changed files
with
1083 additions
and
1081 deletions
+1083
-1081
eigen/eigen.F90
eigen/eigen.F90
+3
-6
force/geo.f90
force/geo.f90
+2
-2
global/types.F90
global/types.F90
+934
-911
hybrid/mixedbasis.F90
hybrid/mixedbasis.F90
+3
-5
init/CMakeLists.txt
init/CMakeLists.txt
+1
-0
init/dimen7.F90
init/dimen7.F90
+4
-7
init/gen_bz.F90
init/gen_bz.F90
+28
-25
init/julia.f90
init/julia.f90
+33
-32
init/kptgen_hybrid.f
init/kptgen_hybrid.f
+38
-42
inpgen/set_inp.f90
inpgen/set_inp.f90
+4
-5
io/r_inpXML.F90
io/r_inpXML.F90
+3
-41
main/fleur.F90
main/fleur.F90
+30
-5
No files found.
eigen/eigen.F90
View file @
f10fd0f8
...
...
@@ -117,12 +117,9 @@ CONTAINS
!
! --> Allocate
!
ALLOCATE
(
ud
%
uloulopn
(
atoms
%
nlod
,
atoms
%
nlod
,
atoms
%
ntype
,
DIMENSION
%
jspd
),
nv2
(
DIMENSION
%
jspd
)
)
ALLOCATE
(
ud
%
ddn
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
DIMENSION
%
jspd
),
eig
(
DIMENSION
%
neigd
),
bkpt
(
3
)
)
ALLOCATE
(
ud
%
us
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
DIMENSION
%
jspd
),
ud
%
uds
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
)
ALLOCATE
(
ud
%
dus
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
DIMENSION
%
jspd
),
ud
%
duds
(
0
:
atoms
%
lmaxd
,
atoms
%
ntype
,
DIMENSION
%
jspd
))
ALLOCATE
(
ud
%
ulos
(
atoms
%
nlod
,
atoms
%
ntype
,
DIMENSION
%
jspd
),
ud
%
dulos
(
atoms
%
nlod
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
)
ALLOCATE
(
ud
%
uulon
(
atoms
%
nlod
,
atoms
%
ntype
,
DIMENSION
%
jspd
),
ud
%
dulon
(
atoms
%
nlod
,
atoms
%
ntype
,
DIMENSION
%
jspd
)
)
call
ud
%
init
(
atoms
,
DIMENSION
%
jspd
)
ALLOCATE
(
nv2
(
DIMENSION
%
jspd
)
)
ALLOCATE
(
eig
(
DIMENSION
%
neigd
),
bkpt
(
3
)
)
ALLOCATE
(
lapw
%
k1
(
DIMENSION
%
nvd
,
DIMENSION
%
jspd
),
lapw
%
k2
(
DIMENSION
%
nvd
,
DIMENSION
%
jspd
),&
lapw
%
k3
(
DIMENSION
%
nvd
,
DIMENSION
%
jspd
),
lapw
%
rk
(
DIMENSION
%
nvd
,
DIMENSION
%
jspd
)
)
!
...
...
force/geo.f90
View file @
f10fd0f8
...
...
@@ -241,11 +241,11 @@ CONTAINS
filename
=
'inp_new.xml'
input_temp
%
l_f
=
input
%
l_f
input_temp
%
gw_neigd
=
dimension_temp
%
neigd
div
(:)
=
MIN
(
kpts_temp
%
n
mop
(:),
1
)
div
(:)
=
MIN
(
kpts_temp
%
n
kpt3
(:),
1
)
stars_temp
%
gmax
=
stars_temp
%
gmaxInit
CALL
w_inpXML
(
atoms_new
,
obsolete_temp
,
vacuum_temp
,
input_temp
,
stars_temp
,
sliceplot_temp
,&
banddos_temp
,
cell_temp
,
sym_temp
,
xcpot_temp
,
noco_temp
,
jij_temp
,
oneD_temp
,
hybrid_temp
,&
kpts_temp
,
kpts_temp
%
n
mop
,
kpts_temp
%
l_gamma
,
noel_temp
,
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,&
kpts_temp
,
kpts_temp
%
n
kpt3
,
kpts_temp
%
l_gamma
,
noel_temp
,
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,&
scale_temp
,
dtild_temp
,
input_temp
%
comment
,
xmlElectronStates
,
xmlPrintCoreStates
,
xmlCoreOccs
,&
atomTypeSpecies
,
speciesRepAtomType
,
.FALSE.
,
filename
,
.TRUE.
,
numSpecies
,
enpara_temp
)
DEALLOCATE
(
atomTypeSpecies
,
speciesRepAtomType
)
...
...
global/types.F90
View file @
f10fd0f8
This diff is collapsed.
Click to expand it.
hybrid/mixedbasis.F90
View file @
f10fd0f8
...
...
@@ -38,7 +38,6 @@ CONTAINS
USE
m_radflo
,
ONLY
:
radflo
USE
m_loddop
,
ONLY
:
loddop
USE
m_util
,
ONLY
:
intgrf_init
,
intgrf
,
rorderpf
USE
m_gen_bz
USE
m_read_core
USE
m_wrapper
USE
m_icorrkeys
...
...
@@ -53,7 +52,7 @@ CONTAINS
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_kpts
),
INTENT
(
IN
OUT
)
::
kpts
TYPE
(
t_kpts
),
INTENT
(
IN
)
::
kpts
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_potden
),
INTENT
(
IN
)
::
v
...
...
@@ -143,6 +142,8 @@ CONTAINS
IF
(
ALLOCATED
(
hybrid
%
basm1
)
)
DEALLOCATE
(
hybrid
%
basm1
)
IF
(
ALLOCATED
(
hybrid
%
basm2
)
)
DEALLOCATE
(
hybrid
%
basm2
)
call
usdus
%
init
(
atoms
,
dimension
%
jspd
)
! If restart is specified read file if it already exists
! create it otherwise
IF
(
l_restart
)
THEN
...
...
@@ -201,9 +202,6 @@ CONTAINS
! initialize gridf for radial integration
CALL
intgrf_init
(
atoms
%
ntype
,
atoms
%
jmtd
,
atoms
%
jri
,
atoms
%
dx
,
atoms
%
rmsh
,
gridf
)
! generate whole BZ form k-points given in kpts
CALL
gen_bz
(
kpts
,
sym
)
!
! read in energy parameters from file eig
! to avoid meaningless energy parameters which occur in the case
...
...
init/CMakeLists.txt
View file @
f10fd0f8
...
...
@@ -29,6 +29,7 @@ init/tetcon.f
)
set
(
fleur_F90
${
fleur_F90
}
init/compile_descr.F90
init/kpoints.f90
init/apws_dim.f90
init/checks.F90
init/dimen7.F90
...
...
init/dimen7.F90
View file @
f10fd0f8
...
...
@@ -28,7 +28,6 @@
USE
m_strgndim
USE
m_convndim
USE
m_inpeigdim
USE
m_kptgen_hybrid
USE
m_ylm
IMPLICIT
NONE
!
...
...
@@ -94,7 +93,7 @@
!---> determine ntype,nop,natd,nwdd,nlod and layerd
!
CALL
first_glance
(
atoms
%
ntype
,
sym
%
nop
,
atoms
%
nat
,
atoms
%
nlod
,
vacuum
%
layerd
,&
input
%
itmax
,
l_kpts
,
l_qpts
,
l_gamma
,
kpts
%
nkpt
,
kpts
%
n
mop
,
jij
%
nqpt
,
nmopq
)
input
%
itmax
,
l_kpts
,
l_qpts
,
l_gamma
,
kpts
%
nkpt
,
kpts
%
n
kpt3
,
jij
%
nqpt
,
nmopq
)
atoms
%
ntype
=
atoms
%
ntype
atoms
%
nlod
=
max
(
atoms
%
nlod
,
1
)
...
...
@@ -330,10 +329,8 @@
&
kpts
,
.false.
,
.FALSE.
)
sym
%
nop
=
n1
sym
%
nop2
=
n2
ELSE
IF
(
l_gamma
.and.
banddos
%
ndir
.eq.
0
)
THEN
CALL
kptgen_hybrid
(
kpts
%
nmop
(
1
),
kpts
%
nmop
(
2
),
kpts
%
nmop
(
3
),&
kpts
%
nkpt
,
sym
%
invs
,
noco
%
l_soc
,
sym
%
nop
,&
sym
%
mrot
,
sym
%
tau
)
ELSE
IF
(
l_gamma
.and.
banddos
%
ndir
.eq.
0
)
THEN
call
judft_error
(
"gamma swtich not supported in old inp file anymore"
,
calledby
=
"dimen7"
)
ELSE
CALL
julia
(&
&
sym
,
cell
,
input
,
noco
,
banddos
,&
...
...
@@ -371,7 +368,7 @@
! Using the k-point generator also for creation of q-points for the
! J-constants calculation:
IF
(
.not.
l_qpts
)
THEN
kpts
%
n
mop
=
nmopq
kpts
%
n
kpt3
=
nmopq
l_tmp
=
(/
noco
%
l_ss
,
noco
%
l_soc
/)
noco
%
l_ss
=
.false.
noco
%
l_soc
=
.false.
...
...
init/gen_bz.F90
View file @
f10fd0f8
...
...
@@ -43,25 +43,27 @@ SUBROUTINE gen_bz( kpts,sym)
! - local arrays -
INTEGER
,
ALLOCATABLE
::
iarr
(:)
REAL
::
rrot
(
3
,
3
,
sym
%
nsym
),
rotkpt
(
3
)
REAL
::
rrot
(
3
,
3
,
2
*
sym
%
nop
),
rotkpt
(
3
)
REAL
,
ALLOCATABLE
::
rarr1
(:,:)
ALLOCATE
(
kpts
%
bkf
(
3
,
sym
%
nsym
*
kpts
%
nkpt
))
ALLOCATE
(
kpts
%
bkp
(
sym
%
nsym
*
kpts
%
nkpt
))
ALLOCATE
(
kpts
%
bksym
(
sym
%
nsym
*
kpts
%
nkpt
))
INTEGER
::
nsym
nsym
=
sym
%
nop
if
(
.not.
sym
%
invs
)
nsym
=
2
*
sym
%
nop
ALLOCATE
(
kpts
%
bkf
(
3
,
nsym
*
kpts
%
nkpt
))
ALLOCATE
(
kpts
%
bkp
(
nsym
*
kpts
%
nkpt
))
ALLOCATE
(
kpts
%
bksym
(
nsym
*
kpts
%
nkpt
))
! Generate symmetry operations in reciprocal space
DO
iop
=
1
,
sym
%
nsym
DO
iop
=
1
,
nsym
IF
(
iop
.le.
sym
%
nop
)
THEN
rrot
(:,:,
iop
)
=
transpose
(
sym
%
mrot
(:,:,
sym
%
invtab
(
iop
)
)
)
rrot
(:,:,
iop
)
=
transpose
(
sym
%
mrot
(:,:,
iop
)
)
ELSE
rrot
(:,:,
iop
)
=
-
rrot
(:,:,
iop
-
sym
%
nop
)
END
IF
END
DO
! Set target number for k points in full BZ
kpts
%
nkptf
=
kpts
%
nkpt3
(
1
)
*
kpts
%
nkpt3
(
2
)
*
kpts
%
nkpt3
(
3
)
IF
(
kpts
%
l_gamma
)
THEN
IF
(
ANY
(
MODULO
(
kpts
%
nkpt3
(:),
2
)
.EQ.
0
))
THEN
...
...
@@ -76,7 +78,7 @@ SUBROUTINE gen_bz( kpts,sym)
kpts
%
bkf
=
0
ic
=
0
DO
iop
=
1
,
sym
%
nsym
DO
iop
=
1
,
nsym
DO
ikpt
=
1
,
kpts
%
nkpt
l_found
=
.FALSE.
rotkpt
=
MATMUL
(
rrot
(:,:,
iop
),
kpts
%
bk
(:,
ikpt
))
...
...
@@ -98,21 +100,22 @@ SUBROUTINE gen_bz( kpts,sym)
END
DO
END
DO
IF
(
kpts
%
nkptf
/
=
ic
)
THEN
WRITE
(
*
,
*
)
''
WRITE
(
*
,
*
)
'Generation of full Brilloun zone from IBZ failed.'
WRITE
(
*
,
*
)
'Number of generated k points in full BZ does not'
WRITE
(
*
,
*
)
'agree with target.'
WRITE
(
*
,
*
)
'Number of generated k points in full BZ: '
,
ic
WRITE
(
*
,
*
)
'Target: '
,
kpts
%
nkptf
WRITE
(
*
,
*
)
''
! DO ikpt=1,kpts%nkptf
! WRITE(*,*) kpts%bkf(:,ikpt)
! END DO
CALL
juDFT_error
(
"gen_bz: error kpts/symmetry"
,
calledby
=
"gen_bz"
)
END
IF
kpts
%
nkptf
=
ic
!IF (kpts%nkptf /= ic) THEN
! WRITE(*,*) ''
! WRITE(*,*) 'Generation of full Brilloun zone from IBZ failed.'
! WRITE(*,*) 'Number of generated k points in full BZ does not'
! WRITE(*,*) 'agree with target.'
! WRITE(*,*) 'Number of generated k points in full BZ: ', ic
! WRITE(*,*) 'Target: ', kpts%nkptf
! WRITE(*,*) ''
! DO ikpt=1,kpts%nkptf
! WRITE(*,*) kpts%bkf(:,ikpt)
! END DO
! CALL juDFT_error("gen_bz: error kpts/symmetry",calledby="gen_bz")
!END IF
! Reallocate bkf, bkp, bksym
ALLOCATE
(
iarr
(
kpts
%
nkptf
))
...
...
init/julia.f90
View file @
f10fd0f8
...
...
@@ -27,9 +27,9 @@
USE
m_bandstr1
use
m_types
IMPLICIT
NONE
TYPE
(
t_sym
),
INTENT
(
IN
OUT
)
::
sym
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_input
),
INTENT
(
IN
OUT
)
::
input
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_noco
),
INTENT
(
IN
)
::
noco
TYPE
(
t_banddos
),
INTENT
(
IN
)
::
banddos
TYPE
(
t_kpts
),
INTENT
(
INOUT
)
::
kpts
...
...
@@ -78,9 +78,9 @@
INTEGER
ikzero
! 0 no shift of k-points;
! 1 shift of k-points for better use of sym in irrBZ
REAL
kzero
(
3
)
! shifting vector to bring one k-point to or
! away from (0,0,0) (for even/odd n
mop
)
! away from (0,0,0) (for even/odd n
kpt3
)
INTEGER
i
,
j
,
k
,
l
,
idiv
,
mkpt
,
addSym
INTEGER
i
,
j
,
k
,
l
,
idiv
,
mkpt
,
addSym
,
nsym
INTEGER
iofile
,
iokpt
,
kpri
,
ktest
,
kmidtet
INTEGER
idivis
(
3
)
LOGICAL
random
,
trias
...
...
@@ -112,8 +112,9 @@
!------------------------------------------------------------
IF
(
l_q
)
THEN
trias
=
input
%
tria
input
%
tria
=
.false.
trias
=
input
%
tria
if
(
input
%
tria
)
call
judft_error
(
"tria=T not implemented for q-point generator"
,
calledby
=
'julia'
)
!input%tria=.false.
ENDIF
IF
(
cell
%
latnam
.EQ.
'squ'
)
THEN
...
...
@@ -147,8 +148,8 @@
&
cell
%
amat
,&
&
idsyst
,
idtype
)
ENDIF
sym
%
nsym
=
sym
%
nop
IF
(
input
%
film
)
sym
%
nsym
=
sym
%
nop2
nsym
=
sym
%
nop
IF
(
input
%
film
)
nsym
=
sym
%
nop2
!
!-------------------- Want to make a Bandstructure ? --------
!
...
...
@@ -188,14 +189,14 @@
bltv
(
j
,
k
)
=
cell
%
amat
(
k
,
j
)
binv
(
j
,
k
)
=
cell
%
bmat
(
k
,
j
)/
tpi_const
rltv
(
j
,
k
)
=
cell
%
bmat
(
k
,
j
)
DO
i
=
1
,
sym
%
nsym
DO
i
=
1
,
nsym
rlsymr
(
k
,
j
,
i
)
=
real
(
sym
%
mrot
(
j
,
k
,
i
)
)
ENDDO
ENDDO
ENDDO
ccr
=
0.0
DO
i
=
1
,
sym
%
nsym
DO
i
=
1
,
nsym
DO
j
=
1
,
3
talfa
(
j
,
i
)
=
0.0
DO
k
=
1
,
3
...
...
@@ -215,7 +216,7 @@
! write (*,'(3f12.6)') ((ccr(j,k,i),j=1,3),k=1,3)
! write (*,*)
ENDDO
DO
i
=
1
,
sym
%
nsym
DO
i
=
1
,
nsym
rlsymr1
(:,:)
=
rlsymr
(:,:,
i
)
ccr1
(:,:)
=
ccr
(:,:,
i
)
DO
j
=
1
,
3
...
...
@@ -226,7 +227,7 @@
ENDDO
ENDDO
IF
((
.not.
noco
%
l_ss
)
.AND.
(
.not.
noco
%
l_soc
)
.AND.
(
2
*
sym
%
nsym
<
nop48
))
THEN
IF
((
.not.
noco
%
l_ss
)
.AND.
(
.not.
noco
%
l_soc
)
.AND.
(
2
*
nsym
<
nop48
))
THEN
IF
(
(
input
%
film
.AND.
(
.not.
sym
%
invs2
))
.OR.
&
&
((
.not.
input
%
film
)
.AND.
(
.not.
sym
%
invs
))
)
THEN
...
...
@@ -235,15 +236,15 @@
! to exploit time reversal symmetry. However, if the new
! symmetry operation is the identity matrix it is excluded.
! This is the case iff it is (-Id) + a translation vector.
DO
i
=
1
,
sym
%
nsym
DO
i
=
1
,
nsym
! This test assumes that ccr(:,:,1) is the identity matrix.
IF
(
.NOT.
ALL
(
ABS
(
ccr
(:,:,
1
)
+
ccr
(:,:,
i
))
.LT.
10e-10
)
)
THEN
ccr
(:,:,
sym
%
nsym
+
addSym
+1
)
=
-
ccr
(:,:,
i
)
rlsymr
(:,:,
sym
%
nsym
+
addSym
+1
)
=
-
rlsymr
(:,:,
i
)
ccr
(:,:,
nsym
+
addSym
+1
)
=
-
ccr
(:,:,
i
)
rlsymr
(:,:,
nsym
+
addSym
+1
)
=
-
rlsymr
(:,:,
i
)
addSym
=
addSym
+
1
END
IF
END
DO
sym
%
nsym
=
sym
%
nsym
+
addSym
nsym
=
nsym
+
addSym
ENDIF
ENDIF
...
...
@@ -258,12 +259,12 @@
! interchangable. GM, 2016.
! CALL brzone(&
! & rltv,
sym%
nsym,ccr,mface,nbsz,nv48,&
! & rltv,nsym,ccr,mface,nbsz,nv48,&
! & cpoint,&
! & xvec,ncorn,nedge,nface,fnorm,fdist)
CALL
brzone2
(&
&
rltv
,
sym
%
nsym
,
ccr
,
mface
,
nbsz
,
nv48
,&
&
rltv
,
nsym
,
ccr
,
mface
,
nbsz
,
nv48
,&
&
cpoint
,&
&
xvec
,
ncorn
,
nedge
,
nface
,
fnorm
,
fdist
)
...
...
@@ -281,7 +282,7 @@
&
iofile
,
ibfile
,
iokpt
,&
&
kpri
,
ktest
,
kmidtet
,
mkpt
,
ndiv3
,&
&
nreg
,
nfulst
,
rltv
,
cell
%
omtil
,&
&
sym
%
nsym
,
ccr
,
mdir
,
mface
,&
&
nsym
,
ccr
,
mdir
,
mface
,&
&
ncorn
,
nface
,
fdist
,
fnorm
,
cpoint
,&
&
voltet
,
ntetra
,
ntet
,
vktet
,&
&
kpts
%
nkpt
,&
...
...
@@ -289,39 +290,39 @@
ELSE
!
! If just the total number of k-points is given, determine
! the divisions in each direction (n
mop
):
! the divisions in each direction (n
kpt3
):
!
! IF (tria) THEN
! nkpt = nkpt/4
! n
mop(:) = nmop
(:) / 2
! n
kpt3(:) = nkpt3
(:) / 2
! ENDIF
IF
(
sum
(
kpts
%
n
mop
)
.EQ.
0
)
THEN
IF
(
sum
(
kpts
%
n
kpt3
)
.EQ.
0
)
THEN
CALL
divi
(&
&
kpts
%
nkpt
,
cell
%
bmat
,
input
%
film
,
sym
%
nop
,
sym
%
nop2
,&
&
kpts
%
n
mop
)
&
kpts
%
n
kpt3
)
ENDIF
!
! Now calculate Monkhorst-Pack k-points:
!
IF
(
kpts
%
n
mop
(
2
)
.EQ.
0
)
kpts
%
nmop
(
2
)
=
kpts
%
nmop
(
1
)
IF
((
.not.
input
%
film
)
.AND.
(
kpts
%
n
mop
(
3
)
.EQ.
0
))
kpts
%
nmop
(
3
)
=
kpts
%
nmop
(
2
)
IF
(
kpts
%
n
kpt3
(
2
)
.EQ.
0
)
kpts
%
nkpt3
(
2
)
=
kpts
%
nkpt3
(
1
)
IF
((
.not.
input
%
film
)
.AND.
(
kpts
%
n
kpt3
(
3
)
.EQ.
0
))
kpts
%
nkpt3
(
3
)
=
kpts
%
nkpt3
(
2
)
IF
(
nbound
.EQ.
1
)
THEN
mkpt
=
(
2
*
kpts
%
n
mop
(
1
)
+1
)
*
(
2
*
kpts
%
nmop
(
2
)
+1
)
IF
(
.not.
input
%
film
)
mkpt
=
mkpt
*
(
2
*
kpts
%
n
mop
(
3
)
+1
)
mkpt
=
(
2
*
kpts
%
n
kpt3
(
1
)
+1
)
*
(
2
*
kpts
%
nkpt3
(
2
)
+1
)
IF
(
.not.
input
%
film
)
mkpt
=
mkpt
*
(
2
*
kpts
%
n
kpt3
(
3
)
+1
)
ELSE
mkpt
=
kpts
%
n
mop
(
1
)
*
kpts
%
nmop
(
2
)
IF
(
.not.
input
%
film
)
mkpt
=
mkpt
*
kpts
%
n
mop
(
3
)
mkpt
=
kpts
%
n
kpt3
(
1
)
*
kpts
%
nkpt3
(
2
)
IF
(
.not.
input
%
film
)
mkpt
=
mkpt
*
kpts
%
n
kpt3
(
3
)
ENDIF
ALLOCATE
(
vkxyz
(
3
,
mkpt
),
wghtkp
(
mkpt
)
)
vkxyz
=
0.0
CALL
kptmop
(&
&
iofile
,
iokpt
,
kpri
,
ktest
,&
&
idsyst
,
idtype
,
kpts
%
n
mop
,
ikzero
,
kzero
,&
&
idsyst
,
idtype
,
kpts
%
n
kpt3
,
ikzero
,
kzero
,&
&
rltv
,
bltv
,
nreg
,
nfulst
,
nbound
,
idimens
,&
&
xvec
,
fnorm
,
fdist
,
ncorn
,
nface
,
nedge
,
cpoint
,&
&
sym
%
nsym
,
ccr
,
rlsymr
,
talfa
,
mkpt
,
mface
,
mdir
,&
&
nsym
,
ccr
,
rlsymr
,
talfa
,
mkpt
,
mface
,
mdir
,&
&
kpts
%
nkpt
,
divis
,
vkxyz
,
nkstar
,
wghtkp
)
ENDIF
...
...
@@ -360,7 +361,7 @@
WRITE
(
113
,
FMT
=
8050
)
(
vkxyz
(
i
,
j
)/
real
(
idiv
),
i
=
1
,
3
)
ENDDO
CLOSE
(
113
)
input
%
tria
=
trias
!
input%tria=trias
RETURN
ENDIF
8050
FORMAT
(
2
(
f14.10
,
1x
),
f14.10
)
...
...
init/kptgen_hybrid.f
View file @
f10fd0f8
...
...
@@ -8,18 +8,18 @@
CONTAINS
! this programm generates an aequdistant kpoint set including the
! Gamma point; it is reduced to IBZ and written in kpts
! this programm generates an aequdistant kpoint set including the
! Gamma point; it is reduced to IBZ and written in kpts (M.B.)
!Modified for types D.W.
SUBROUTINE
kptgen_hybrid
(
nx
,
ny
,
nz
,
nkpt
,
invs
,
l_soc
,
nop
,
mrot
,
tau
)
SUBROUTINE
kptgen_hybrid
(
kpts
,
invs
,
l_soc
,
nop
,
mrot
,
tau
)
USE
m_types
IMPLICIT
NONE
TYPE
(
t_kpts
),
INTENT
(
INOUT
)::
kpts
! - scalars -
INTEGER
,
INTENT
(
IN
)
::
nx
,
ny
,
nz
INTEGER
,
INTENT
(
IN
)
::
nkpt
INTEGER
,
INTENT
(
IN
)
::
nop
LOGICAL
,
INTENT
(
IN
)
::
invs
LOGICAL
,
INTENT
(
IN
)
::
l_soc
...
...
@@ -27,12 +27,10 @@
INTEGER
,
INTENT
(
IN
)
::
mrot
(
3
,
3
,
nop
)
REAL
,
INTENT
(
IN
)
::
tau
(
3
,
nop
)
! - local scalars -
INTEGER
::
i
,
j
,
k
INTEGER
::
ikpt
,
ikpt0
,
ikpt1
,
nkpti
INTEGER
::
iop
INTEGER
::
nrkpt
,
nsym
INTEGER
::
i
,
j
,
k
,
nkpt
INTEGER
::
ikpt
,
ikpt0
,
nkpti
INTEGER
::
nsym
! - local arrays -
INTEGER
::
nkpt3
(
3
)
! generate axbxc k-point set
INTEGER
,
ALLOCATABLE
::
rot
(:,:,:),
rrot
(:,:,:)
INTEGER
,
ALLOCATABLE
::
invtab
(:)
INTEGER
,
ALLOCATABLE
::
neqkpt
(:)
...
...
@@ -41,23 +39,18 @@
REAL
,
ALLOCATABLE
::
rtau
(:,:)
REAL
,
ALLOCATABLE
::
bk
(:,:),
bkhlp
(:,:)
REAL
,
ALLOCATABLE
::
rarr
(:)
REAL
::
rotkpt
(
3
)
REAL
::
rdum
LOGICAL
::
inv
,
ldum
LOGICAL
::
ldum
IF
(
nx
*
ny
*
nz
.ne.
nkpt
)
&
STOP
'kptgen_hybrid: nx*ny*nz=/nkpt'
nkpt3
(
1
)
=
nx
;
nkpt3
(
2
)
=
ny
;
nkpt3
(
3
)
=
nz
nkpt
=
kpts
%
nkpt3
(
1
)
*
kpts
%
nkpt3
(
2
)
*
kpts
%
nkpt3
(
3
)
ALLOCATE
(
bk
(
3
,
nkpt
),
bkhlp
(
3
,
nkpt
)
)
ikpt
=
0
DO
i
=
0
,
nkpt3
(
1
)
-1
DO
j
=
0
,
nkpt3
(
2
)
-1
DO
k
=
0
,
nkpt3
(
3
)
-1
DO
i
=
0
,
kpts
%
nkpt3
(
1
)
-1
DO
j
=
0
,
kpts
%
nkpt3
(
2
)
-1
DO
k
=
0
,
kpts
%
nkpt3
(
3
)
-1
ikpt
=
ikpt
+
1
bk
(:,
ikpt
)
=
(/
1.0
*
i
/
nkpt3
(
1
),
1.0
*
j
/
nkpt3
(
2
),
&
1.0
*
k
/
nkpt3
(
3
)
/)
bk
(:,
ikpt
)
=
(/
1.0
*
i
/
kpts
%
nkpt3
(
1
),
1.0
*
j
/
kpts
%
nkpt3
(
2
),
&
1.0
*
k
/
kpts
%
nkpt3
(
3
)
/)
END
DO
END
DO
END
DO
...
...
@@ -112,16 +105,16 @@
END
DO
ALLOCATE
(
kptp
(
nkpt
),
symkpt
(
nkpt
),
rarr
(
3
),
iarr2
(
3
),
iarr
(
nkpt
)
)
ALLOCATE
(
pkpt
(
nkpt3
(
1
)
+1
,
nkpt3
(
2
)
+1
,
nkpt3
(
3
)
+1
)
)
ALLOCATE
(
pkpt
(
kpts
%
nkpt3
(
1
)
+1
,
kpts
%
nkpt3
(
2
)
+1
,
kpts
%
nkpt3
(
3
)
+1
)
)
pkpt
=
0
DO
ikpt
=
1
,
nkpt
iarr2
=
nint
(
bk
(:,
ikpt
)
*
nkpt3
)
+
1
iarr2
=
nint
(
bk
(:,
ikpt
)
*
kpts
%
nkpt3
)
+
1
pkpt
(
iarr2
(
1
),
iarr2
(
2
),
iarr2
(
3
))
=
ikpt
END
DO
pkpt
(
nkpt3
(
1
)
+1
,
:
,
:
)
=
pkpt
(
1
,:,:)
pkpt
(
:
,
nkpt3
(
2
)
+1
,
:
)
=
pkpt
(:,
1
,:)
pkpt
(
:
,
:
,
nkpt3
(
3
)
+1
)
=
pkpt
(:,:,
1
)
pkpt
(
kpts
%
nkpt3
(
1
)
+1
,
:
,
:
)
=
pkpt
(
1
,:,:)
pkpt
(
:
,
kpts
%
nkpt3
(
2
)
+1
,
:
)
=
pkpt
(:,
1
,:)
pkpt
(
:
,
:
,
kpts
%
nkpt3
(
3
)
+1
)
=
pkpt
(:,:,
1
)
IF
(
any
(
pkpt
.eq.
0
))
&
STOP
'kptgen: Definition of pkpt-pointer failed.'
...
...
@@ -132,15 +125,15 @@
kptp
(
i
)
=
i
symkpt
(
i
)
=
1
DO
k
=
2
,
nsym
rarr
=
matmul
(
rrot
(:,:,
k
),
bk
(:,
i
))
*
nkpt3
rarr
=
matmul
(
rrot
(:,:,
k
),
bk
(:,
i
))
*
kpts
%
nkpt3
iarr2
=
nint
(
rarr
)
IF
(
any
(
abs
(
iarr2
-
rarr
)
.gt.
1d-10
))
THEN
WRITE
(
6
,
'(A,I3,A)'
)
'kptgen: Symmetry operation'
,
k
,
&
' incompatible with k-point set.'
ldum
=
.true.
END
IF
iarr2
=
modulo
(
iarr2
,
nkpt3
)
+
1
IF
(
any
(
iarr2
.gt.
nkpt3
))
iarr2
=
modulo
(
iarr2
,
kpts
%
nkpt3
)
+
1
IF
(
any
(
iarr2
.gt.
kpts
%
nkpt3
))
&
STOP
'kptgen: pointer indices exceed pointer dimensions.'
j
=
pkpt
(
iarr2
(
1
),
iarr2
(
2
),
iarr2
(
3
))
IF
(
j
.eq.
0
)
STOP
'kptgen: k-point index is zero (bug?)'
...
...
@@ -171,15 +164,14 @@
kptp
=
iarr
(
kptp
)
kptp
(
iarr
)
=
kptp
symkpt
(
iarr
)
=
symkpt
DO
i
=
1
,
nkpt3
(
1
)
+1
DO
j
=
1
,
nkpt3
(
2
)
+1
DO
k
=
1
,
nkpt3
(
3
)
+1
DO
i
=
1
,
kpts
%
nkpt3
(
1
)
+1
DO
j
=
1
,
kpts
%
nkpt3
(
2
)
+1
DO
k
=
1
,
kpts
%
nkpt3
(
3
)
+1
pkpt
(
i
,
j
,
k
)
=
iarr
(
pkpt
(
i
,
j
,
k
))
END
DO
END
DO
END
DO
DEALLOCATE
(
rarr
,
iarr
,
iarr2
)
ALLOCATE
(
neqkpt
(
nkpti
)
)
neqkpt
=
0
DO
ikpt0
=
1
,
nkpti
...
...
@@ -188,15 +180,19 @@
END
DO
END
DO
OPEN
(
unit
=
41
,
file
=
'kpts'
,
form
=
'formatted'
,
status
=
'new'
)
! Do not do any IO, but store in kpts
kpts
%
nkpt
=
nkpti
if
(
allocated
(
kpts
%
bk
))
deallocate
(
kpts
%
bk
)
if
(
allocated
(
kpts
%
wtkpt
))
deallocate
(
kpts
%
wtkpt
)
ALLOCATE
(
kpts
%
bk
(
3
,
kpts
%
nkpt
),
kpts
%
wtkpt
(
kpts
%
nkpt
))
rdum
=
kgv
(
(/
nkpt3
(
1
),
nkpt3
(
2
),
nkpt3
(
3
)/),
3
)
WRITE
(
41
,
'(I5,F20.10)'
)
nkpti
,
rdum
DO
ikpt
=
1
,
nkpti
WRITE
(
41
,
'(4F10.5)'
)
bk
(:,
ikpt
)
*
rdum
,
1.0
*
neqkpt
(
ikpt
)
!3x,f7.5,3x,f7.5,3x,f7.5,f10.5
kpts
%
bk
(:,
ikpt
)
=
bk
(:,
ikpt
)
kpts
%
wtkpt
(
ikpt
)
=
neqkpt
(
ikpt
)
END
DO
CLOSE
(
41
)
kpts
%
posScale
=
1.0
CONTAINS
! Returns least common multiple of the integers iarr(1:n).
...
...
inpgen/set_inp.f90
View file @
f10fd0f8
...
...
@@ -29,7 +29,6 @@
USE
m_types
USE
m_juDFT_init
USE
m_julia
USE
m_kptgen_hybrid
USE
m_od_kptsgen
USE
m_inv3
...
...
@@ -418,7 +417,7 @@
! kpts generation
CALL
inv3
(
cell
%
amat
,
cell
%
bmat
,
cell
%
omtil
)
cell
%
bmat
=
tpi_const
*
cell
%
bmat
kpts
%
n
mop
(:)
=
div
(:)
kpts
%
n
kpt3
(:)
=
div
(:)
kpts
%
l_gamma
=
l_gamma
IF
(
.NOT.
oneD
%
odd
%
d1
)
THEN
IF
(
jij
%
l_J
)
THEN
...
...
@@ -431,9 +430,9 @@
sym
%
nop2
=
n2
ELSE
IF
(
kpts
%
l_gamma
.and.
banddos
%
ndir
.eq.
0
)
THEN
STOP
'Error: No kpoint set generation for gamma=T yet!'
CALL
kptgen_hybrid
(
kpts
%
nmop
(
1
),
kpts
%
nmop
(
2
),
kpts
%
nmop
(
3
),&
kpts
%
nkpt
,
sym
%
invs
,
noco
%
l_soc
,
sym
%
nop
,&
sym
%
mrot
,
sym
%
tau
)
!CALL kptgen_hybrid(kpts%nkpt3(1),kpts%nkpt3(2),kpts%nkpt3
(3),&
!
kpts%nkpt,sym%invs,noco%l_soc,sym%nop,&
!
sym%mrot,sym%tau)
ELSE
CALL
julia
(
sym
,
cell
,
input
,
noco
,
banddos
,
kpts
,
.FALSE.
,
.TRUE.
)
END
IF
...
...
io/r_inpXML.F90
View file @
f10fd0f8
...
...
@@ -34,9 +34,6 @@ SUBROUTINE r_inpXML(&
USE
m_icorrkeys
USE
m_constants
USE
m_hybridmix
,
ONLY
:
aMix_VHSE
,
omega_VHSE
USE
m_julia
USE
m_kptgen_hybrid
USE
m_od_kptsgen
USE
m_strgndim
USE
m_strgn
USE
m_od_strgn1
...
...
@@ -59,6 +56,7 @@ SUBROUTINE r_inpXML(&
USE
m_apwsdim
USE
m_sort
USE
m_nocoInputCheck
USE
m_kpoints
USE
m_enpara
,
ONLY
:
r_enpara
IMPLICIT
NONE
...
...
@@ -402,7 +400,6 @@ SUBROUTINE r_inpXML(&
! Read in Brillouin zone integration parameters
kpts
%
nkpt3
=
0
kpts
%
nmop
=
0
l_kpts
=
.FALSE.
valueString
=
TRIM
(
ADJUSTL
(
xmlGetAttributeValue
(
'/fleurInput/calculationSetup/bzIntegration/@mode'
)))
...
...
@@ -455,9 +452,6 @@ SUBROUTINE r_inpXML(&
kpts
%
nkpt3
(
2
)
=
evaluateFirstIntOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/@ny'
))
kpts
%
nkpt3
(
3
)
=
evaluateFirstIntOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/@nz'
))
kpts
%
l_gamma
=
evaluateFirstBoolOnly
(
xmlGetAttributeValue
(
TRIM
(
ADJUSTL
(
xPathA
))//
'/@gamma'
))
kpts
%
nmop
(
1
)
=
kpts
%
nkpt3
(
1
)
kpts
%
nmop
(
2
)
=
kpts
%
nkpt3
(
2
)
kpts
%
nmop
(
3
)
=
kpts
%
nkpt3
(
3
)
kpts
%
nkpt
=
kpts
%
nkpt3
(
1
)
*
kpts
%
nkpt3
(
2
)
*
kpts
%
nkpt3
(
3
)
END
IF
...
...
@@ -1956,40 +1950,8 @@ SUBROUTINE r_inpXML(&
END
IF
! Calculate missing kpts parameters
IF
(
.not.
l_kpts
)
THEN
IF
(
.NOT.
oneD
%
odd
%
d1
)
THEN