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
d14979f7
Commit
d14979f7
authored
Nov 28, 2017
by
Gregor Michalicek
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' into wannier_patrick
parents
626f83d4
03b7c479
Changes
15
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
15 changed files
with
2601 additions
and
2402 deletions
+2601
-2402
cmake/compilerflags.cmake
cmake/compilerflags.cmake
+2
-2
diagonalization/fleur_elemental.cpp
diagonalization/fleur_elemental.cpp
+163
-0
force/geo.f90
force/geo.f90
+4
-4
global/types.F90
global/types.F90
+21
-1
init/dimen7.F90
init/dimen7.F90
+20
-38
init/dimens.F90
init/dimens.F90
+3
-7
init/inped.F90
init/inped.F90
+13
-16
init/postprocessInput.F90
init/postprocessInput.F90
+17
-17
inpgen/set_inp.f90
inpgen/set_inp.f90
+6
-5
io/r_inpXML.F90
io/r_inpXML.F90
+11
-3
io/rw_inp.f90
io/rw_inp.f90
+22
-19
io/w_inpXML.f90
io/w_inpXML.f90
+18
-18
io/xml/inputSchema.h
io/xml/inputSchema.h
+2282
-2253
main/fleur_init.F90
main/fleur_init.F90
+15
-19
main/vgen.F90
main/vgen.F90
+4
-0
No files found.
cmake/compilerflags.cmake
View file @
d14979f7
...
...
@@ -2,9 +2,9 @@
if
(
${
CMAKE_Fortran_COMPILER_ID
}
MATCHES
"Intel"
)
message
(
"Intel Fortran detected"
)
if
(
${
CMAKE_Fortran_COMPILER_VERSION
}
VERSION_LESS
"14.1.0.0"
)
set
(
CMAKE_Fortran_FLAGS
"
${
CMAKE_Fortran_FLAGS
}
-mkl -r8 -openmp"
)
set
(
CMAKE_Fortran_FLAGS
"
${
CMAKE_Fortran_FLAGS
}
-mkl -r8 -openmp
-assume byterecl
"
)
else
()
set
(
CMAKE_Fortran_FLAGS
"
${
CMAKE_Fortran_FLAGS
}
-mkl -r8 -qopenmp"
)
set
(
CMAKE_Fortran_FLAGS
"
${
CMAKE_Fortran_FLAGS
}
-mkl -r8 -qopenmp
-assume byterecl
"
)
endif
()
set
(
CMAKE_Fortran_FLAGS_RELEASE
"
${
CMAKE_Fortran_FLAGS_RELEASE
}
-xHost -O2"
)
set
(
CMAKE_Fortran_FLAGS_DEBUG
"
${
CMAKE_Fortran_FLAGS_DEBUG
}
-C -traceback -O0 -g -ftrapuv -check uninit -check pointers -CB "
)
...
...
diagonalization/fleur_elemental.cpp
0 → 100644
View file @
d14979f7
/*
Copyright (c) 2014, Daniel Wortmann
All rights reserved.
This file provides an interface from FLEUR to Elemental
*/
#include "elemental.hpp"
using
namespace
std
;
using
namespace
elem
;
// Typedef our real or complex types to 'C' for convenience
#ifdef CPP_INVERSION
typedef
double
C
;
#else
typedef
Complex
<
double
>
C
;
#endif
class
global_data
{
public:
Grid
*
g
;
mpi
::
Comm
mpi_comm
;
int
matrix_dimension
;
DistMatrix
<
C
>
*
H_mat
,
*
S_mat
;
DistMatrix
<
C
,
STAR
,
VC
>
eigenvectors
;
DistMatrix
<
double
,
VC
,
STAR
>
eigenvalues
;
};
//Global variables
static
global_data
*
gd
;
DistMatrix
<
C
>*
fleur_matrix
(
int
n
,
C
*
buffer
)
{
// Create the distributed matrix
DistMatrix
<
C
,
STAR
,
VC
>
*
mat
;
// The Matrix should be a n x n matrix in 1-D cyclic distribution
mat
=
new
DistMatrix
<
C
,
STAR
,
VC
>
(
n
,
n
,
*
(
gd
->
g
));
C
*
localbuffer
=
mat
->
Buffer
();
// this is the local buffer of the matrix
const
int
buffersize1
=
mat
->
LocalWidth
();
const
int
buffersize2
=
mat
->
LocalHeight
();
int
localindex
=
0
;
int
fleur_index
=
0
;
// Now copy all the data into local buffer to initialize the matrix
// Loop over columns of local data
for
(
int
i
=
mpi
::
CommRank
(
gd
->
mpi_comm
);
i
<
n
;
i
+=
mpi
::
CommSize
(
gd
->
mpi_comm
))
{
for
(
int
j
=
0
;
j
<=
i
;
j
++
)
{
localbuffer
[
localindex
++
]
=
buffer
[
fleur_index
++
];
}
// further Off-diagonal elements are set to zero !Probably not needed
for
(
int
j
=
0
;
j
<
n
-
i
-
1
;
j
++
)
{
localbuffer
[
localindex
++
]
=
0.0
;
}
}
DistMatrix
<
C
>
*
mat2
=
new
DistMatrix
<
C
>
(
*
mat
);
delete
mat
;
//*mat2=*mat;
return
mat2
;
}
extern
"C"
{
void
fl_el_initialize
(
int
n
,
C
*
hbuf
,
C
*
sbuf
,
int
mpi_used_comm
)
// Set the two matrices
{
// Initialize the Library
int
argc
=
0
;
char
**
argv
;
Initialize
(
argc
,
argv
);
//Store the matrix dimension& the mpi_communicator
gd
=
new
global_data
;
gd
->
mpi_comm
=
MPI_Comm_f2c
(
mpi_used_comm
);
gd
->
matrix_dimension
=
n
;
// First we need a mpi-grid
gd
->
g
=
new
Grid
(
gd
->
mpi_comm
);
// Store the Matrices
gd
->
H_mat
=
fleur_matrix
(
n
,
hbuf
);
gd
->
S_mat
=
fleur_matrix
(
n
,
sbuf
);
}
void
fl_el_diagonalize
(
int
no_of_eigenpairs
)
// Diagonalize the Matrix and return the number of local eigenvalues
{
/* this is for the development version
// The subset determines the no of eigenvalues found
HermitianEigSubset<double> subset;
subset.indexSubset=true;
subset.lowerIndex=0;
subset.upperIndex=no_of_global_eigenpairs;
// Space for eigenvalues
DistMatrix<double> eigenval(g);
DistMatrix<C> eigenvec(g);
//default sorting
const SortType sort = static_cast<SortType>(0);
//call diagonalization
HermitianGenDefEig( AXBX, LOWER, H_mat, S_mat, eigenval, eigenvec, sort, subset );
*/
DistMatrix
<
double
,
VR
,
STAR
>
eigenval
(
*
(
gd
->
g
));
DistMatrix
<
C
>
evec
(
*
(
gd
->
g
));
HermitianGenDefiniteEigType
eigtype
=
AXBX
;
UpperOrLower
uplo
=
UPPER
;
if
(
mpi
::
CommRank
(
gd
->
mpi_comm
)
==
0
)
{
cout
<<
"H/S-matrix of size "
<<
gd
->
matrix_dimension
<<
endl
;
}
Display
(
*
(
gd
->
H_mat
));
Display
(
*
(
gd
->
S_mat
));
HermitianGenDefiniteEig
(
eigtype
,
uplo
,
*
(
gd
->
H_mat
),
*
(
gd
->
S_mat
),
eigenval
,
evec
,
0
,
no_of_eigenpairs
);
//redistribute matrices
//eigenvalues are of type DistMatrix(C,STAR,VC);
gd
->
eigenvalues
=
eigenval
;
gd
->
eigenvectors
=
evec
;
no_of_eigenpairs
=
gd
->
eigenvectors
.
LocalWidth
();
}
void
fl_el_eigenvalues
(
int
neig
,
double
*
eig
){
//Return the eigenvalues
double
*
buf
=
gd
->
eigenvalues
.
Buffer
();
if
(
neig
>
gd
->
eigenvalues
.
LocalWidth
()
*
gd
->
eigenvalues
.
LocalHeight
())
{
cerr
<<
"Error in dimensions in fleur_elemental
\n
"
;
}
for
(
int
i
=
0
;
i
<
neig
;
i
++
){
eig
[
i
]
=
buf
[
i
];
}
}
void
fl_el_eigenvectors
(
int
neig
,
double
*
eig
,
C
*
eigvec
){
//Return all the local eigenvectors&eigenvalues
double
*
eigbuf
=
gd
->
eigenvalues
.
Buffer
();
Display
(
gd
->
eigenvalues
);
Display
(
gd
->
eigenvectors
);
C
*
eigbuff
=
gd
->
eigenvectors
.
Buffer
();
int
local_index
=
0
;
for
(
int
i
=
0
;
i
<
neig
;
i
++
)
{
//Copy eigenvalue
int
pe
=
mpi
::
CommRank
(
gd
->
mpi_comm
);
int
in
=
i
*
mpi
::
CommSize
(
gd
->
mpi_comm
)
+
pe
;
cout
<<
"PE:"
<<
pe
<<
":"
<<
i
<<
"->"
<<
in
<<
endl
;
eig
[
i
]
=
eigbuf
[
i
];
//Copy eigenvector
for
(
int
j
=
0
;
j
<
gd
->
matrix_dimension
;
j
++
){
eigvec
[
local_index
]
=
eigbuff
[
local_index
];
local_index
++
;
}
}
}
}
force/geo.f90
View file @
d14979f7
...
...
@@ -214,7 +214,7 @@ CONTAINS
CALL
rw_inp
(
'r'
,
atoms_temp
,
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
,
noel_temp
,
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,
scale_temp
,
dtild_temp
,&
kpts_temp
,
noel_temp
,
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,
dtild_temp
,&
input_temp
%
comment
)
input_temp
%
l_f
=
input
%
l_f
input_temp
%
tkb
=
input
%
tkb
...
...
@@ -224,7 +224,7 @@ CONTAINS
vacuum_temp
=
vacuum
CALL
rw_inp
(
'W'
,
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
,
noel_temp
,
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,
scale_temp
,
a3_temp
(
3
),&
kpts_temp
,
noel_temp
,
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,
a3_temp
(
3
),&
input_temp
%
comment
)
ELSE
...
...
@@ -236,7 +236,7 @@ CONTAINS
CALL
r_inpXML
(
atoms_temp
,
obsolete_temp
,
vacuum_temp
,
input_temp
,
stars_temp
,
sliceplot_temp
,&
banddos_temp
,
dimension_temp
,
cell_temp
,
sym_temp
,
xcpot_temp
,
noco_temp
,
Jij_temp
,&
oneD_temp
,
hybrid_temp
,
kpts_temp
,
enpara_temp
,
coreSpecInput_temp
,
wann_temp
,
noel_temp
,&
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,
scale_temp
,
dtild_temp
,
xmlElectronStates
,&
namex_temp
,
relcor_temp
,
a1_temp
,
a2_temp
,
a3_temp
,
dtild_temp
,
xmlElectronStates
,&
xmlPrintCoreStates
,
xmlCoreOccs
,
atomTypeSpecies
,
speciesRepAtomType
,
l_kpts_temp
)
numSpecies
=
SIZE
(
speciesRepAtomType
)
filename
=
'inp_new.xml'
...
...
@@ -247,7 +247,7 @@ CONTAINS
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
%
nkpt3
,
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
,&
dtild_temp
,
input_temp
%
comment
,
xmlElectronStates
,
xmlPrintCoreStates
,
xmlCoreOccs
,&
atomTypeSpecies
,
speciesRepAtomType
,
.FALSE.
,
filename
,
.TRUE.
,
numSpecies
,
enpara_temp
)
DEALLOCATE
(
atomTypeSpecies
,
speciesRepAtomType
)
DEALLOCATE
(
xmlElectronStates
,
xmlPrintCoreStates
,
xmlCoreOccs
)
...
...
global/types.F90
View file @
d14979f7
...
...
@@ -556,7 +556,6 @@ MODULE m_types
REAL
::
tkb
LOGICAL
::
gauss
LOGICAL
::
l_bmt
!INTEGER:: scale
INTEGER
::
jspins
INTEGER
::
kcrel
LOGICAL
::
frcor
...
...
@@ -574,6 +573,10 @@ MODULE m_types
LOGICAL
::
sso_opt
(
2
)
LOGICAL
::
total
LOGICAL
::
l_inpXML
REAL
::
scaleCell
REAL
::
scaleA1
REAL
::
scaleA2
REAL
::
scaleC
REAL
::
ellow
REAL
::
elup
REAL
::
rkmax
...
...
@@ -919,6 +922,7 @@ MODULE m_types
PROCEDURE
::
init_potden_types
PROCEDURE
::
init_potden_simple
GENERIC
::
init
=>
init_potden_types
,
init_potden_simple
PROCEDURE
::
resetPotDen
END
TYPE
t_potden
CONTAINS
SUBROUTINE
usdus_init
(
ud
,
atoms
,
jsp
)
...
...
@@ -1010,5 +1014,21 @@ CONTAINS
pd
%
mmpMat
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
init_potden_simple
SUBROUTINE
resetPotDen
(
pd
)
IMPLICIT
NONE
CLASS
(
t_potden
),
INTENT
(
INOUT
)
::
pd
pd
%
pw
=
CMPLX
(
0.0
,
0.0
)
pd
%
mt
=
0.0
pd
%
vacz
=
0.0
pd
%
vacxy
=
CMPLX
(
0.0
,
0.0
)
pd
%
cdom
=
CMPLX
(
0.0
,
0.0
)
pd
%
cdomvz
=
CMPLX
(
0.0
,
0.0
)
pd
%
cdomvxy
=
CMPLX
(
0.0
,
0.0
)
pd
%
mmpMat
=
CMPLX
(
0.0
,
0.0
)
END
SUBROUTINE
resetPotDen
END
MODULE
m_types
init/dimen7.F90
View file @
d14979f7
...
...
@@ -57,7 +57,7 @@
!-------------------------------------------------------------------
! .. Local Scalars ..
REAL
::
thetad
,
xa
,
epsdisp
,
epsforce
,
rmtmax
,
arltv1
,
arltv2
,
arltv3
REAL
::
s
,
r
,
d
,
idsprs
,
scale
REAL
::
s
,
r
,
d
,
idsprs
INTEGER
::
ok
,
ilo
,
n
,
nstate
,
i
,
j
,
na
,
n1
,
n2
,
jrc
,
nopd
,
symfh
INTEGER
::
nmopq
(
3
)
...
...
@@ -116,7 +116,7 @@
CALL
rw_inp
(
'r'
,&
&
atoms
,
obsolete
,
vacuum
,
input
,
stars
,
sliceplot
,
banddos
,&
&
cell
,
sym
,
xcpot
,
noco
,
jij
,
oneD
,
hybrid
,
kpts
,&
&
noel
,
namex
,
relcor
,
a1
,
a2
,
a3
,
scale
)
&
noel
,
namex
,
relcor
,
a1
,
a2
,
a3
)
!---> pk non-collinear
!---> read the angle and spin-spiral information from nocoinp
...
...
@@ -191,9 +191,9 @@
!
! ---> now, set the lattice harmonics, determine nlhd
!
cell
%
amat
(:,
1
)
=
a1
(:)
*
scale
cell
%
amat
(:,
2
)
=
a2
(:)
*
scale
cell
%
amat
(:,
3
)
=
a3
(:)
*
scale
cell
%
amat
(:,
1
)
=
a1
(:)
*
input
%
scaleCell
cell
%
amat
(:,
2
)
=
a2
(:)
*
input
%
scaleCell
cell
%
amat
(:,
3
)
=
a3
(:)
*
input
%
scaleCell
CALL
inv3
(
cell
%
amat
,
cell
%
bmat
,
cell
%
omtil
)
IF
(
input
%
film
)
cell
%
omtil
=
cell
%
omtil
/
cell
%
amat
(
3
,
3
)
*
vacuum
%
dvac
!-odim
...
...
@@ -259,17 +259,14 @@
CALL
soc_sym
(
sym
%
nop
,
sym
%
mrot
,
noco
%
theta
,
noco
%
phi
,
cell
%
amat
,
error
)
IF
(
ANY
(
error
(:))
)
THEN
WRITE
(
*
,
fmt
=
'(1x)'
)
WRITE
(
*
,
fmt
=
'(A)'
)&
&
'Symmetry incompatible with SOC spin-quantization axis ,'
WRITE
(
*
,
fmt
=
'(A)'
)&
&
'do not perform self-consistent calculations !'
WRITE
(
*
,
fmt
=
'(A)'
)
'Symmetry incompatible with SOC spin-quantization axis ,'
WRITE
(
*
,
fmt
=
'(A)'
)
'do not perform self-consistent calculations !'
WRITE
(
*
,
fmt
=
'(1x)'
)
IF
(
input
%
eonly
.or.
(
noco
%
l_soc
.and.
noco
%
l_ss
)
.or.
input
%
gw
.ne.
0
)
THEN
! .or. .
CONTINUE
ELSE
IF
(
input
%
itmax
>
1
)
THEN
CALL
juDFT_error
(
"symmetry & SOC"
,
calledby
&
&
=
"dimen7"
)
CALL
juDFT_error
(
"symmetry & SOC"
,
calledby
=
"dimen7"
)
ENDIF
ENDIF
ENDIF
...
...
@@ -281,8 +278,7 @@
IF
(
noco
%
l_ss
)
THEN
! test symmetry for spin-spiral
ALLOCATE
(
error
(
sym
%
nop
)
)
CALL
ss_sym
(
sym
%
nop
,
sym
%
mrot
,
noco
%
qss
,
error
)
IF
(
ANY
(
error
(:))
)
CALL
juDFT_error
(
"symmetry & SSDW"
,&
&
calledby
=
"dimen7"
)
IF
(
ANY
(
error
(:))
)
CALL
juDFT_error
(
"symmetry & SSDW"
,
calledby
=
"dimen7"
)
DEALLOCATE
(
error
)
ENDIF
!--- J<
...
...
@@ -306,10 +302,8 @@
ENDIF
IF
(
xcpot
%
gmaxxc
.le.
10.0
**
(
-6
)
)
THEN
WRITE
(
6
,
'(" xcpot%gmaxxc=0 : xcpot%gmaxxc=stars%gmax choosen as default",&
& " value")'
)
WRITE
(
6
,
'(" concerning memory, you may want to choose",&
& " a smaller value for stars%gmax")'
)
WRITE
(
6
,
'(" xcpot%gmaxxc=0 : xcpot%gmaxxc=stars%gmax choosen as default value")'
)
WRITE
(
6
,
'(" concerning memory, you may want to choose a smaller value for stars%gmax")'
)
xcpot
%
gmaxxc
=
stars
%
gmax
END
IF
...
...
@@ -324,17 +318,13 @@
n2
=
sym
%
nop2
sym
%
nop
=
1
sym
%
nop2
=
1
CALL
julia
(&
&
sym
,
cell
,
input
,
noco
,
banddos
,&
&
kpts
,
.false.
,
.FALSE.
)
CALL
julia
(
sym
,
cell
,
input
,
noco
,
banddos
,
kpts
,
.false.
,
.FALSE.
)
sym
%
nop
=
n1
sym
%
nop2
=
n2
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
,&
&
kpts
,
.false.
,
.FALSE.
)
CALL
julia
(
sym
,
cell
,
input
,
noco
,
banddos
,
kpts
,
.false.
,
.FALSE.
)
ENDIF
ELSE
CALL
od_kptsgen
(
kpts
%
nkpt
)
...
...
@@ -343,17 +333,15 @@
IF
(
input
%
gw
.eq.
2
)
THEN
INQUIRE
(
file
=
'QGpsi'
,
exist
=
l_kpts
)
! Use QGpsi if it exists ot
IF
(
l_kpts
)
THEN
WRITE
(
6
,
*
)&
&
'QGpsi exists and will be used to generate kpts-file'
OPEN
(
15
,
file
=
'QGpsi'
,
form
=
'unformatted'
,
status
=
'old'
,&
&
action
=
'read'
)
WRITE
(
6
,
*
)
'QGpsi exists and will be used to generate kpts-file'
OPEN
(
15
,
file
=
'QGpsi'
,
form
=
'unformatted'
,
status
=
'old'
,
action
=
'read'
)
OPEN
(
41
,
file
=
'kpts'
,
form
=
'formatted'
,
status
=
'unknown'
)
REWIND
(
41
)
READ
(
15
)
kpts
%
nkpt
WRITE
(
41
,
'(i5,f20.10)'
)
kpts
%
nkpt
,
1.0
DO
n
=
1
,
kpts
%
nkpt
READ
(
15
)
q
WRITE
(
41
,
'(4f10.5)'
)
MATMUL
(
TRANSPOSE
(
cell
%
amat
),
q
)/
scale
,
1.0
WRITE
(
41
,
'(4f10.5)'
)
MATMUL
(
TRANSPOSE
(
cell
%
amat
),
q
)/
input
%
scaleCell
,
1.0
READ
(
15
)
ENDDO
CLOSE
(
15
)
...
...
@@ -372,17 +360,14 @@
l_tmp
=
(/
noco
%
l_ss
,
noco
%
l_soc
/)
noco
%
l_ss
=
.false.
noco
%
l_soc
=
.false.
CALL
julia
(&
&
sym
,
cell
,
input
,
noco
,
banddos
,&
&
kpts
,
.true.
,
.FALSE.
)
CALL
julia
(
sym
,
cell
,
input
,
noco
,
banddos
,
kpts
,
.true.
,
.FALSE.
)
noco
%
l_ss
=
l_tmp
(
1
);
noco
%
l_soc
=
l_tmp
(
2
)
ENDIF
!
! now proceed as usual
!
CALL
inpeig_dim
(
input
,
obsolete
,
cell
,
noco
,
oneD
,
jij
,&
&
kpts
,
dimension
,
stars
)
CALL
inpeig_dim
(
input
,
obsolete
,
cell
,
noco
,
oneD
,
jij
,
kpts
,
dimension
,
stars
)
vacuum
%
layerd
=
max
(
vacuum
%
layerd
,
1
)
dimension
%
nstd
=
max
(
dimension
%
nstd
,
30
)
atoms
%
ntype
=
atoms
%
ntype
...
...
@@ -390,18 +375,15 @@
atoms
%
nlod
=
max
(
atoms
%
nlod
,
2
)
! for chkmt
dimension
%
jspd
=
input
%
jspins
CALL
parawrite
(&
&
sym
,
stars
,
atoms
,
sphhar
,
dimension
,
vacuum
,
obsolete
,&
&
kpts
,
oneD
)
CALL
parawrite
(
sym
,
stars
,
atoms
,
sphhar
,
dimension
,
vacuum
,
obsolete
,
kpts
,
oneD
)
!
DEALLOCATE
(
sym
%
mrot
,
sym
%
tau
,&
&
atoms
%
lmax
,
atoms
%
ntypsy
,
atoms
%
neq
,
atoms
%
nlhtyp
,
atoms
%
rmt
,
atoms
%
zatom
,
atoms
%
jri
,
atoms
%
dx
,
atoms
%
nlo
,
atoms
%
llo
,
atoms
%
nflip
,
atoms
%
bmu
,
noel
,&
&
vacuum
%
izlay
,
atoms
%
ncst
,
atoms
%
lnonsph
,
atoms
%
taual
,
atoms
%
pos
,
atoms
%
nz
,
atoms
%
relax
,&
&
atoms
%
l_geo
,
noco
%
soc_opt
,
noco
%
alph
,
noco
%
beta
,
atoms
%
lda_u
,
noco
%
l_relax
,
jij
%
l_magn
,
jij
%
M
,
noco
%
b_con
,
sphhar
%
clnu
,
sphhar
%
nlh
,&
&
sphhar
%
llh
,
sphhar
%
nmem
,
sphhar
%
mlh
,
jij
%
magtype
,
jij
%
nmagtype
,
hybrid
%
select1
,
hybrid
%
lcutm1
,&
&
hybrid
%
lcutwf
)
!
RETURN
END
SUBROUTINE
dimen7
END
MODULE
m_dimen7
init/dimens.F90
View file @
d14979f7
...
...
@@ -194,14 +194,10 @@ CONTAINS
IF
(
l_kpts
)
WRITE
(
6
,
*
)
' No fl7para-file found, '
WRITE
(
6
,
*
)
' invoking dimen7... '
!call first_glance to generate k-points
CALL
first_glance
(&
&
n1
,
n2
,
n3
,
n5
,
n6
,
input
%
itmax
,&
&
l_kpts
,
l_qpts
,
ldum
,
n7
,
n8
,
n9
,
n10
)
CALL
dimen7
(&
&
input
,
sym
,
stars
,
atoms
,
sphhar
,&
&
dimension
,
vacuum
,
obsolete
,
kpts
,&
&
oneD
,
hybrid
,
Jij
,
cell
)
CALL
first_glance
(
n1
,
n2
,
n3
,
n5
,
n6
,
input
%
itmax
,
l_kpts
,
l_qpts
,
ldum
,
n7
,
n8
,
n9
,
n10
)
CALL
dimen7
(
input
,
sym
,
stars
,
atoms
,
sphhar
,
dimension
,
vacuum
,
obsolete
,
kpts
,&
oneD
,
hybrid
,
Jij
,
cell
)
ENDIF
! in case of a parallel calculation we have to broadcast
#ifdef CPP_MPI
...
...
init/inped.F90
View file @
d14979f7
...
...
@@ -26,11 +26,9 @@
! *******************************************************
!
CONTAINS
SUBROUTINE
inped
(
&
&
atoms
,
obsolete
,
vacuum
,&
&
input
,
banddos
,
xcpot
,
sym
,&
&
cell
,
sliceplot
,
noco
,&
&
stars
,
oneD
,
jij
,
hybrid
,
kpts
,
scale
,
a1
,
a2
,
a3
,
namex
,
relcor
)
SUBROUTINE
inped
(
atoms
,
obsolete
,
vacuum
,
input
,
banddos
,
xcpot
,
sym
,&
cell
,
sliceplot
,
noco
,&
stars
,
oneD
,
jij
,
hybrid
,
kpts
,
a1
,
a2
,
a3
,
namex
,
relcor
)
USE
m_rwinp
USE
m_chkmt
USE
m_inpnoco
...
...
@@ -56,7 +54,6 @@
TYPE
(
t_jij
),
INTENT
(
INOUT
)
::
jij
TYPE
(
t_hybrid
),
INTENT
(
INOUT
)
::
hybrid
TYPE
(
t_kpts
),
INTENT
(
INOUT
)
::
kpts
REAL
,
INTENT
(
OUT
)
::
scale
REAL
,
INTENT
(
OUT
)
::
a1
(
3
)
REAL
,
INTENT
(
OUT
)
::
a2
(
3
)
REAL
,
INTENT
(
OUT
)
::
a3
(
3
)
...
...
@@ -88,7 +85,7 @@
na
=
0
CALL
rw_inp
(
'r'
,
atoms
,
obsolete
,
vacuum
,
input
,
stars
,
sliceplot
,
banddos
,&
cell
,
sym
,
xcpot
,
noco
,
jij
,
oneD
,
hybrid
,
kpts
,
noel
,
namex
,
relcor
,
a1
,
a2
,
a3
,
scale
)
cell
,
sym
,
xcpot
,
noco
,
jij
,
oneD
,
hybrid
,
kpts
,
noel
,
namex
,
relcor
,
a1
,
a2
,
a3
)
input
%
l_core_confpot
=
.TRUE.
!this is the former CPP_CORE switch!
input
%
l_useapw
=
.FALSE.
!this is the former CPP_APW switch!
...
...
@@ -139,9 +136,9 @@
CALL
juDFT_error
(
"latnam"
,
calledby
=
"inped"
)
ENDIF
dtild
=
a3
(
3
)
IF
(
scale
.EQ.
0.
)
scale
=
1.
vacuum
%
dvac
=
scale
*
vacuum
%
dvac
dtild
=
scale
*
dtild
IF
(
input
%
scaleCell
.EQ.
0.0
)
input
%
scaleCell
=
1.0
vacuum
%
dvac
=
input
%
scaleCell
*
vacuum
%
dvac
dtild
=
input
%
scaleCell
*
dtild
!+odim
IF
(
.NOT.
oneD
%
odd
%
d1
)
THEN
IF
((
dtild
-
vacuum
%
dvac
.LT.
0.0
)
.AND.
input
%
film
)
THEN
...
...
@@ -164,11 +161,11 @@
IF
(
vacuum
%
nmz
>
vacuum
%
nmzd
)
CALL
juDFT_error
(
"nmzd"
,
calledby
=
"inped"
)
vacuum
%
nmzxy
=
vacuum
%
nmzxyd
IF
(
vacuum
%
nmzxy
>
vacuum
%
nmzxyd
)
CALL
juDFT_error
(
"nmzxyd"
,
calledby
=
"inped"
)
a1
(:)
=
scale
*
a1
(:)
a2
(:)
=
scale
*
a2
(:)
a3
(:)
=
scale
*
a3
(:)
WRITE
(
6
,
FMT
=
8050
)
scale
WRITE
(
16
,
FMT
=
8050
)
scale
a1
(:)
=
input
%
scaleCell
*
a1
(:)
a2
(:)
=
input
%
scaleCell
*
a2
(:)
a3
(:)
=
input
%
scaleCell
*
a3
(:)
WRITE
(
6
,
FMT
=
8050
)
input
%
scaleCell
WRITE
(
16
,
FMT
=
8050
)
input
%
scaleCell
8050
FORMAT
(
' unit cell scaled by '
,
f10.6
)
WRITE
(
6
,
FMT
=
8060
)
cell
%
z1
WRITE
(
16
,
FMT
=
8060
)
cell
%
z1
...
...
@@ -349,7 +346,7 @@
!
!---> for films, the z-coordinates are given in absolute values:
!
IF
(
input
%
film
)
atoms
%
taual
(
3
,
na
)
=
scale
*
atoms
%
taual
(
3
,
na
)/
a3
(
3
)
IF
(
input
%
film
)
atoms
%
taual
(
3
,
na
)
=
input
%
scaleCell
*
atoms
%
taual
(
3
,
na
)/
a3
(
3
)
!
! Transform intern coordinates to cartesian:
!
...
...
init/postprocessInput.F90
View file @
d14979f7
...
...
@@ -98,14 +98,14 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
DO
iType
=
1
,
atoms
%
ntype
IF
(
atoms
%
nlo
(
iType
)
.GE.
1
)
THEN
IF
(
input
%
secvar
)
THEN
CALL
juDFT_error
(
"LO + sevcar not implemented"
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"LO + sevcar not implemented"
,
calledby
=
"
postprocessInput
"
)
END
IF
IF
(
input
%
isec1
<
input
%
itmax
)
THEN
CALL
juDFT_error
(
"LO + Wu not implemented"
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"LO + Wu not implemented"
,
calledby
=
"
postprocessInput
"
)
END
IF
IF
(
atoms
%
nlo
(
iType
)
.GT.
atoms
%
nlod
)
THEN
WRITE
(
6
,
*
)
'nlo(n) ='
,
atoms
%
nlo
(
iType
),
' > nlod ='
,
atoms
%
nlod
CALL
juDFT_error
(
"nlo(n)>nlod"
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"nlo(n)>nlod"
,
calledby
=
"
postprocessInput
"
)
END
IF
DO
j
=
1
,
atoms
%
nlo
(
iType
)
IF
(
.NOT.
input
%
l_useapw
)
THEN
...
...
@@ -116,7 +116,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
ENDIF
IF
(
(
atoms
%
llo
(
j
,
iType
)
.GT.
atoms
%
llod
)
.OR.
(
mod
(
-
atoms
%
llod
,
10
)
-1
)
.GT.
atoms
%
llod
)
THEN
WRITE
(
6
,
*
)
'llo(j,n) ='
,
atoms
%
llo
(
j
,
iType
),
' > llod ='
,
atoms
%
llod
CALL
juDFT_error
(
"llo(j,n)>llod"
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"llo(j,n)>llod"
,
calledby
=
"
postprocessInput
"
)
END
IF
END
DO
...
...
@@ -138,7 +138,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END
IF
endif
WRITE
(
6
,
'(A,I2,A,I2)'
)
'I use'
,
atoms
%
ulo_der
(
ilo
,
iType
),
'. derivative of l ='
,
atoms
%
llo
(
ilo
,
iType
)
IF
(
atoms
%
llo
(
ilo
,
iType
)
>
atoms
%
llod
)
CALL
juDFT_error
(
" l > llod!!!"
,
calledby
=
"
r_inpXML
"
)
IF
(
atoms
%
llo
(
ilo
,
iType
)
>
atoms
%
llod
)
CALL
juDFT_error
(
" l > llod!!!"
,
calledby
=
"
postprocessInput
"
)
l
=
atoms
%
llo
(
ilo
,
iType
)
IF
(
ilo
.EQ.
1
)
THEN
atoms
%
lo1l
(
l
,
iType
)
=
ilo
...
...
@@ -171,42 +171,42 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END
DO
IF
(
atoms
%
n_u
.GT.
0
)
THEN
IF
(
input
%
secvar
)
CALL
juDFT_error
(
"LDA+U and sevcar not implemented"
,
calledby
=
"
r_inpXML
"
)
IF
(
input
%
isec1
<
input
%
itmax
)
CALL
juDFT_error
(
"LDA+U and Wu not implemented"
,
calledby
=
"
r_inpXML
"
)
IF
(
noco
%
l_mperp
)
CALL
juDFT_error
(
"LDA+U and l_mperp not implemented"
,
calledby
=
"
r_inpXML
"
)
IF
(
input
%
secvar
)
CALL
juDFT_error
(
"LDA+U and sevcar not implemented"
,
calledby
=
"
postprocessInput
"
)
IF
(
input
%
isec1
<
input
%
itmax
)
CALL
juDFT_error
(
"LDA+U and Wu not implemented"
,
calledby
=
"
postprocessInput
"
)
IF
(
noco
%
l_mperp
)
CALL
juDFT_error
(
"LDA+U and l_mperp not implemented"
,
calledby
=
"
postprocessInput
"
)
END
IF
! Check DOS related stuff (from inped)
IF
((
banddos
%
ndir
.LT.
0
)
.AND..NOT.
banddos
%
dos
)
THEN
CALL
juDFT_error
(
'STOP banddos: the inbuild dos-program <0'
//&
' can only be used if dos = true'
,
calledby
=
"
r_inpXML
"
)
' can only be used if dos = true'
,
calledby
=
"
postprocessInput
"
)
END
IF
IF
((
banddos
%
ndir
.LT.
0
)
.AND.
banddos
%
dos
)
THEN
IF
(
banddos
%
e1_dos
-
banddos
%
e2_dos
.LT.
1e-3
)
THEN
CALL
juDFT_error
(
"STOP banddos: no valid energy window for "
//&
"internal dos-program"
,
calledby
=
"
r_inpXML
"
)
"internal dos-program"
,
calledby
=
"
postprocessInput
"
)
END
IF
IF
(
banddos
%
sig_dos
.LT.
0
)
THEN
CALL
juDFT_error
(
"STOP DOS: no valid broadening (sig_dos) for "
//&
"internal dos-PROGRAM"
,
calledby
=
"
r_inpXML
"
)
"internal dos-PROGRAM"
,
calledby
=
"
postprocessInput
"
)
END
IF
END
IF
IF
(
banddos
%
vacdos
)
THEN
IF
(
.NOT.
banddos
%
dos
)
THEN
CALL
juDFT_error
(
"STOP DOS: only set vacdos = .true. if dos = .true."
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"STOP DOS: only set vacdos = .true. if dos = .true."
,
calledby
=
"
postprocessInput
"
)
END
IF
IF
(
.NOT.
vacuum
%
starcoeff
.AND.
(
vacuum
%
nstars
.NE.
1
))
THEN
CALL
juDFT_error
(
"STOP banddos: if stars = f set vacuum=1"
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"STOP banddos: if stars = f set vacuum=1"
,
calledby
=
"
postprocessInput
"
)
END
IF
IF
(
vacuum
%
layers
.LT.
1
)
THEN
CALL
juDFT_error
(
"STOP DOS: specify layers if vacdos = true"
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"STOP DOS: specify layers if vacdos = true"
,
calledby
=
"
postprocessInput
"
)
END
IF
DO
i
=
1
,
vacuum
%
layers
IF
(
vacuum
%
izlay
(
i
,
1
)
.LT.
1
)
THEN
CALL
juDFT_error
(
"STOP DOS: all layers must be at z>0"
,
calledby
=
"
r_inpXML
"
)
CALL
juDFT_error
(
"STOP DOS: all layers must be at z>0"
,
calledby
=
"
postprocessInput
"
)
END
IF
END
DO
END
IF
...
...
@@ -275,7 +275,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
END
DO
!IF (input%film .OR.oneD%odd%d1) THEN
! WRITE(*,*) 'There might be additional work required for the k points here!'
! WRITE(*,*) '...in
r_inpXML
. See inpeig_dim for comparison!'
! WRITE(*,*) '...in
postprocessInput
. See inpeig_dim for comparison!'
!END IF
CALL
apws_dim
(
bk
(:),
cell
,
input
,
noco
,
oneD
,
nv
,
nv2
,
kq1
,
kq2
,
kq3
)
stars
%
kq1_fft
=
max
(
kq1
,
stars
%
kq1_fft
)
...
...
@@ -309,7 +309,7 @@ SUBROUTINE postprocessInput(mpi,input,sym,stars,atoms,vacuum,obsolete,kpts,&
l_vca
=
.FALSE.
INQUIRE
(
file
=
"vca.in"
,
exist
=
l_vca
)
IF
(
l_vca
)
THEN
WRITE
(
*
,
*
)
'Note: Implementation for virtual crystal approximation should be changed in
r_inpXML
!'
WRITE
(
*
,
*
)
'Note: Implementation for virtual crystal approximation should be changed in
postprocessInput
!'
WRITE
(
*
,
*
)
'I am not sure whether the implementation actually makes any sense. It is from inped.'
WRITE
(
*
,
*
)
'We have to get rid of the file vca.in!'
OPEN
(
17
,
file
=
'vca.in'
,
form
=
'formatted'
)
...
...
inpgen/set_inp.f90