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
a818b405
Commit
a818b405
authored
Apr 06, 2017
by
Daniel Wortmann
Browse files
Options
Browse Files
Download
Plain Diff
Merge branch 'develop' of fleur-git:fleur into develop
parents
9e6eb616
f91cf039
Changes
13
Hide whitespace changes
Inline
Side-by-side
Showing
13 changed files
with
416 additions
and
162 deletions
+416
-162
io/CMakeLists.txt
io/CMakeLists.txt
+1
-0
io/cdn_io.F90
io/cdn_io.F90
+26
-92
io/cdnpot_io_common.F90
io/cdnpot_io_common.F90
+199
-0
io/cdnpot_io_hdf.F90
io/cdnpot_io_hdf.F90
+173
-36
io/pot_io.F90
io/pot_io.F90
+5
-22
main/cdngen.f90
main/cdngen.f90
+1
-1
main/mix.F90
main/mix.F90
+2
-2
main/totale.f90
main/totale.f90
+1
-1
main/vgen.F90
main/vgen.F90
+4
-4
optional/bmt.f90
optional/bmt.f90
+1
-1
optional/cdnsp.f90
optional/cdnsp.f90
+1
-1
optional/flipcdn.f90
optional/flipcdn.f90
+1
-1
vgen/rhodirgen.f90
vgen/rhodirgen.f90
+1
-1
No files found.
io/CMakeLists.txt
View file @
a818b405
...
...
@@ -15,6 +15,7 @@ io/nocoInputCheck.F90
io/inpnoco.F90
io/loddop.f90
io/cdnpot_io_hdf.F90
io/cdnpot_io_common.F90
io/cdn_io.F90
io/pot_io.F90
io/rw_inp.f90
...
...
io/cdn_io.F90
View file @
a818b405
...
...
@@ -19,6 +19,7 @@ MODULE m_cdn_io
USE
m_loddop
USE
m_wrtdop
USE
m_cdnpot_io_hdf
USE
m_cdnpot_io_common
#ifdef CPP_HDF
USE
hdf5
#endif
...
...
@@ -129,12 +130,13 @@ MODULE m_cdn_io
END
SUBROUTINE
printDensityFileInfo
SUBROUTINE
readDensity
(
stars
,
vacuum
,
atoms
,
sphhar
,
input
,
sym
,
oneD
,
archiveType
,
inOrOutCDN
,&
SUBROUTINE
readDensity
(
stars
,
vacuum
,
atoms
,
cell
,
sphhar
,
input
,
sym
,
oneD
,
archiveType
,
inOrOutCDN
,&
relCdnIndex
,
fermiEnergy
,
l_qfix
,
iter
,
fr
,
fpw
,
fz
,
fzxy
,
cdom
,
cdomvz
,
cdomvxy
)
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
sphhar
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
...
...
@@ -155,7 +157,7 @@ MODULE m_cdn_io
! local variables
INTEGER
::
mode
,
datend
,
k
,
i
,
iVac
,
j
,
iUnit
LOGICAL
::
l_exist
,
l_rhomatFile
LOGICAL
::
l_exist
,
l_rhomatFile
,
l_DimChange
CHARACTER
(
LEN
=
30
)
::
filename
#ifdef CPP_HDF
...
...
@@ -216,9 +218,14 @@ MODULE m_cdn_io
currentStepfunctionIndex
,
readDensityIndex
,
lastDensityIndex
)
CALL
readDensityHDF
(
fileID
,
input
,
stars
,
sphhar
,
atoms
,
vacuum
,
oneD
,
archiveName
,
densityType
,&
fermiEnergy
,
l_qfix
,
iter
,
fr
,
fpw
,
fz
,
fzxy
,
cdom
,
cdomvz
,
cdomvxy
)
fermiEnergy
,
l_qfix
,
l_DimChange
,
iter
,
fr
,
fpw
,
fz
,
fzxy
,
cdom
,
cdomvz
,
cdomvxy
)
CALL
closeCDNPOT_HDF
(
fileID
)
IF
(
l_DimChange
)
THEN
CALL
writeDensity
(
stars
,
vacuum
,
atoms
,
cell
,
sphhar
,
input
,
sym
,
oneD
,
archiveType
,
inOrOutCDN
,&
1
,
-1.0
,
fermiEnergy
,
l_qfix
,
iter
,
fr
,
fpw
,
fz
,
fzxy
,
cdom
,
cdomvz
,
cdomvxy
)
END
IF
RETURN
ELSE
WRITE
(
*
,
*
)
'cdn.hdf file or relevant density entry not found.'
...
...
@@ -346,7 +353,7 @@ MODULE m_cdn_io
INTEGER
::
mode
,
iterTemp
,
k
,
i
,
iVac
,
j
,
iUnit
INTEGER
::
d1
,
d10
,
asciioffset
,
iUnitTemp
LOGICAL
::
l_exist
,
l_storeIndices
,
l_writeNew
LOGICAL
::
l_exist
,
l_storeIndices
,
l_writeNew
,
l_same
LOGICAL
::
l_writeAll
CHARACTER
(
len
=
30
)
::
filename
CHARACTER
(
len
=
5
)
::
cdnfile
...
...
@@ -379,92 +386,10 @@ MODULE m_cdn_io
CALL
openCDN_HDF
(
fileID
,
currentStarsIndex
,
currentLatharmsIndex
,
currentStructureIndex
,&
currentStepfunctionIndex
,
readDensityIndex
,
lastDensityIndex
)
l_storeIndices
=
.FALSE.
l_writeAll
=
.FALSE.
IF
(
currentStructureIndex
.EQ.
0
)
THEN
currentStructureIndex
=
1
l_storeIndices
=
.TRUE.
l_writeAll
=
.TRUE.
CALL
writeStructureHDF
(
fileID
,
input
,
atoms
,
cell
,
vacuum
,
oneD
,
currentStructureIndex
)
ELSE
CALL
readStructureHDF
(
fileID
,
inputTemp
,
atomsTemp
,
cellTemp
,
vacuumTemp
,
oneDTemp
,
currentStructureIndex
)
l_writeNew
=
.FALSE.
IF
(
atoms
%
ntype
.NE.
atomsTemp
%
ntype
)
l_writeNew
=
.TRUE.
IF
(
atoms
%
nat
.NE.
atomsTemp
%
nat
)
l_writeNew
=
.TRUE.
IF
(
atoms
%
lmaxd
.NE.
atomsTemp
%
lmaxd
)
l_writeNew
=
.TRUE.
IF
(
atoms
%
jmtd
.NE.
atomsTemp
%
jmtd
)
l_writeNew
=
.TRUE.
IF
(
vacuum
%
dvac
.NE.
vacuumTemp
%
dvac
)
l_writeNew
=
.TRUE.
IF
(
ANY
(
ABS
(
cell
%
amat
(:,:)
-
cellTemp
%
amat
(:,:))
.GT.
1e-10
))
l_writeNew
=
.TRUE.
IF
(
.NOT.
l_writeNew
)
THEN
IF
(
ANY
(
atoms
%
nz
(:)
.NE.
atomsTemp
%
nz
(:)))
l_writeNew
=
.TRUE.
IF
(
ANY
(
atoms
%
lmax
(:)
.NE.
atomsTemp
%
lmax
(:)))
l_writeNew
=
.TRUE.
END
IF
IF
(
.NOT.
l_writeNew
)
THEN
DO
i
=
1
,
atoms
%
nat
IF
(
ANY
(
ABS
(
atoms
%
pos
(:,
i
)
-
atomsTemp
%
pos
(:,
i
))
.GT.
1e-10
))
l_writeNew
=
.TRUE.
END
DO
END
IF
IF
(
l_writeNew
)
THEN
currentStructureIndex
=
currentStructureIndex
+
1
l_storeIndices
=
.TRUE.
l_writeAll
=
.TRUE.
CALL
writeStructureHDF
(
fileID
,
input
,
atoms
,
cell
,
vacuum
,
oneD
,
currentStructureIndex
)
END
IF
END
IF
IF
(
currentStarsIndex
.EQ.
0
)
THEN
currentStarsIndex
=
1
l_storeIndices
=
.TRUE.
CALL
writeStarsHDF
(
fileID
,
currentStarsIndex
,
stars
)
ELSE
CALL
readStarsHDF
(
fileID
,
currentStarsIndex
,
starsTemp
)
l_writeNew
=
.FALSE.
IF
(
ABS
(
stars
%
gmax
-
starsTemp
%
gmax
)
.GT.
1e-10
)
l_writeNew
=
.TRUE.
IF
(
stars
%
ng3
.NE.
starsTemp
%
ng3
)
l_writeNew
=
.TRUE.
IF
(
stars
%
ng2
.NE.
starsTemp
%
ng2
)
l_writeNew
=
.TRUE.
IF
(
stars
%
mx1
.NE.
starsTemp
%
mx1
)
l_writeNew
=
.TRUE.
IF
(
stars
%
mx2
.NE.
starsTemp
%
mx2
)
l_writeNew
=
.TRUE.
IF
(
stars
%
mx3
.NE.
starsTemp
%
mx3
)
l_writeNew
=
.TRUE.
IF
(
stars
%
kimax
.NE.
starsTemp
%
kimax
)
l_writeNew
=
.TRUE.
IF
(
stars
%
kimax2
.NE.
starsTemp
%
kimax2
)
l_writeNew
=
.TRUE.
IF
(
l_writeNew
.OR.
l_writeAll
)
THEN
currentStarsIndex
=
currentStarsIndex
+
1
l_storeIndices
=
.TRUE.
CALL
writeStarsHDF
(
fileID
,
currentStarsIndex
,
stars
)
END
IF
END
IF
IF
(
currentLatharmsIndex
.EQ.
0
)
THEN
currentLatharmsIndex
=
1
l_storeIndices
=
.TRUE.
CALL
writeLatharmsHDF
(
fileID
,
currentLatharmsIndex
,
sphhar
)
ELSE
CALL
readLatharmsHDF
(
fileID
,
currentLatharmsIndex
,
sphharTemp
)
l_writeNew
=
.FALSE.
IF
(
sphhar
%
ntypsd
.NE.
sphharTemp
%
ntypsd
)
l_writeNew
=
.TRUE.
IF
(
sphhar
%
memd
.NE.
sphharTemp
%
memd
)
l_writeNew
=
.TRUE.
IF
(
sphhar
%
nlhd
.NE.
sphharTemp
%
nlhd
)
l_writeNew
=
.TRUE.
IF
(
l_writeNew
.OR.
l_writeAll
)
THEN
currentLatharmsIndex
=
currentLatharmsIndex
+
1
l_storeIndices
=
.TRUE.
CALL
writeLatharmsHDF
(
fileID
,
currentLatharmsIndex
,
sphhar
)
END
IF
END
IF
IF
(
currentStepfunctionIndex
.EQ.
0
)
THEN
currentStepfunctionIndex
=
1
l_storeIndices
=
.TRUE.
CALL
writeStepfunctionHDF
(
fileID
,
currentStepfunctionIndex
,
currentStarsIndex
,
stars
)
ELSE
CALL
readStepfunctionHDF
(
fileID
,
currentStepfunctionIndex
,
starsTemp
)
l_writeNew
=
.FALSE.
IF
(
stars
%
ng3
.NE.
starsTemp
%
ng3
)
l_writeNew
=
.TRUE.
IF
(
stars
%
mx1
.NE.
starsTemp
%
mx1
)
l_writeNew
=
.TRUE.
IF
(
stars
%
mx2
.NE.
starsTemp
%
mx2
)
l_writeNew
=
.TRUE.
IF
(
stars
%
mx3
.NE.
starsTemp
%
mx3
)
l_writeNew
=
.TRUE.
IF
(
l_writeNew
.OR.
l_writeAll
)
THEN
currentStepfunctionIndex
=
currentStepfunctionIndex
+
1
l_storeIndices
=
.TRUE.
CALL
writeStepfunctionHDF
(
fileID
,
currentStepfunctionIndex
,
currentStarsIndex
,
stars
)
END
IF
END
IF
CALL
checkAndWriteMetadataHDF
(
fileID
,
input
,
atoms
,
cell
,
vacuum
,
oneD
,
stars
,
sphhar
,
sym
,&
currentStarsIndex
,
currentLatharmsIndex
,
currentStructureIndex
,&
currentStepfunctionIndex
,
l_storeIndices
)
previousDensityIndex
=
readDensityIndex
writeDensityIndex
=
readDensityIndex
IF
(
relCdnIndex
.NE.
0
)
THEN
...
...
@@ -919,8 +844,10 @@ MODULE m_cdn_io
LOGICAL
,
INTENT
(
IN
)
::
l_xcExtended
,
l_ExtData
LOGICAL
,
INTENT
(
OUT
)
::
l_error
TYPE
(
t_stars
)
::
starsTemp
INTEGER
::
mode
,
ioStatus
,
ngz
,
izmin
,
izmax
LOGICAL
::
l_exist
LOGICAL
::
l_exist
,
l_same
INTEGER
::
currentStarsIndex
,
currentLatharmsIndex
,
currentStructureIndex
INTEGER
::
currentStepfunctionIndex
,
readDensityIndex
,
lastDensityIndex
...
...
@@ -947,7 +874,14 @@ MODULE m_cdn_io
IF
(
currentStarsIndex
.LT.
1
)
THEN
mode
=
CDN_DIRECT_MODE
! (no stars entry found in cdn.hdf file)
ELSE
CALL
readStarsHDF
(
fileID
,
currentStarsIndex
,
stars
)
CALL
readStarsHDF
(
fileID
,
currentStarsIndex
,
starsTemp
)
CALL
compareStars
(
stars
,
starsTemp
,
l_same
)
WRITE
(
*
,
*
)
'l_same'
,
l_same
IF
(
l_same
)
THEN
CALL
readStarsHDF
(
fileID
,
currentStarsIndex
,
stars
)
ELSE
mode
=
CDN_DIRECT_MODE
! (no adequate stars entry found in cdn.hdf file)
END
IF
END
IF
CALL
closeCDNPOT_HDF
(
fileID
)
#endif
...
...
io/cdnpot_io_common.F90
0 → 100644
View file @
a818b405
!--------------------------------------------------------------------------------
! Copyright (c) 2017 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!
!!! This module contains common subroutines required for density IO
!!! as well as for potential IO
!!!
!!! GM'17
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
MODULE
m_cdnpot_io_common
USE
m_types
USE
m_juDFT
USE
m_cdnpot_io_hdf
#ifdef CPP_HDF
USE
hdf5
#endif
CONTAINS
SUBROUTINE
compareStars
(
stars
,
refStars
,
l_same
)
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_stars
),
INTENT
(
IN
)
::
refStars
LOGICAL
,
INTENT
(
OUT
)
::
l_same
l_same
=
.TRUE.
IF
(
ABS
(
stars
%
gmaxInit
-
refStars
%
gmaxInit
)
.GT.
1e-10
)
l_same
=
.FALSE.
IF
(
stars
%
ng3
.NE.
refStars
%
ng3
)
l_same
=
.FALSE.
IF
(
stars
%
ng2
.NE.
refStars
%
ng2
)
l_same
=
.FALSE.
IF
(
stars
%
mx1
.NE.
refStars
%
mx1
)
l_same
=
.FALSE.
IF
(
stars
%
mx2
.NE.
refStars
%
mx2
)
l_same
=
.FALSE.
IF
(
stars
%
mx3
.NE.
refStars
%
mx3
)
l_same
=
.FALSE.
END
SUBROUTINE
compareStars
SUBROUTINE
compareStepfunctions
(
stars
,
refStars
,
l_same
)
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_stars
),
INTENT
(
IN
)
::
refStars
LOGICAL
,
INTENT
(
OUT
)
::
l_same
l_same
=
.TRUE.
IF
(
stars
%
ng3
.NE.
refStars
%
ng3
)
l_same
=
.FALSE.
IF
(
stars
%
mx1
.NE.
refStars
%
mx1
)
l_same
=
.FALSE.
IF
(
stars
%
mx2
.NE.
refStars
%
mx2
)
l_same
=
.FALSE.
IF
(
stars
%
mx3
.NE.
refStars
%
mx3
)
l_same
=
.FALSE.
END
SUBROUTINE
compareStepfunctions
SUBROUTINE
compareStructure
(
atoms
,
vacuum
,
cell
,
refAtoms
,
refVacuum
,&
refCell
,
l_same
)
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
,
refAtoms
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
,
refVacuum
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
,
refCell
LOGICAL
,
INTENT
(
OUT
)
::
l_same
l_same
=
.TRUE.
IF
(
atoms
%
ntype
.NE.
refAtoms
%
ntype
)
l_same
=
.FALSE.
IF
(
atoms
%
nat
.NE.
refAtoms
%
nat
)
l_same
=
.FALSE.
IF
(
atoms
%
lmaxd
.NE.
refAtoms
%
lmaxd
)
l_same
=
.FALSE.
IF
(
atoms
%
jmtd
.NE.
refAtoms
%
jmtd
)
l_same
=
.FALSE.
IF
(
vacuum
%
dvac
.NE.
refVacuum
%
dvac
)
l_same
=
.FALSE.
IF
(
ANY
(
ABS
(
cell
%
amat
(:,:)
-
refCell
%
amat
(:,:))
.GT.
1e-10
))
l_same
=
.FALSE.
IF
(
l_same
)
THEN
IF
(
ANY
(
atoms
%
nz
(:)
.NE.
refAtoms
%
nz
(:)))
l_same
=
.FALSE.
IF
(
ANY
(
atoms
%
lmax
(:)
.NE.
refAtoms
%
lmax
(:)))
l_same
=
.FALSE.
END
IF
IF
(
l_same
)
THEN
DO
i
=
1
,
atoms
%
nat
IF
(
ANY
(
ABS
(
atoms
%
pos
(:,
i
)
-
refAtoms
%
pos
(:,
i
))
.GT.
1e-10
))
l_same
=
.FALSE.
END
DO
END
IF
! NOTE: This subroutine certainly is not yet complete. Especially symmetry should
! also be stored and compared for structure considerations.
END
SUBROUTINE
compareStructure
SUBROUTINE
compareLatharms
(
latharms
,
refLatharms
,
l_same
)
TYPE
(
t_sphhar
)
::
latharms
,
refLatharms
LOGICAL
,
INTENT
(
OUT
)
::
l_same
l_same
=
.TRUE.
IF
(
latharms
%
ntypsd
.NE.
refLatharms
%
ntypsd
)
l_same
=
.FALSE.
IF
(
latharms
%
memd
.NE.
refLatharms
%
memd
)
l_same
=
.FALSE.
IF
(
latharms
%
nlhd
.NE.
refLatharms
%
nlhd
)
l_same
=
.FALSE.
END
SUBROUTINE
compareLatharms
#ifdef CPP_HDF
SUBROUTINE
checkAndWriteMetadataHDF
(
fileID
,
input
,
atoms
,
cell
,
vacuum
,
oneD
,
stars
,
latharms
,
sym
,&
currentStarsIndex
,
currentLatharmsIndex
,
currentStructureIndex
,&
currentStepfunctionIndex
,
l_storeIndices
)
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_atoms
),
INTENT
(
IN
)
::
atoms
TYPE
(
t_cell
),
INTENT
(
IN
)
::
cell
TYPE
(
t_vacuum
),
INTENT
(
IN
)
::
vacuum
TYPE
(
t_oneD
),
INTENT
(
IN
)
::
oneD
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
TYPE
(
t_sphhar
),
INTENT
(
IN
)
::
latharms
TYPE
(
t_sym
),
INTENT
(
IN
)
::
sym
INTEGER
(
HID_T
),
INTENT
(
IN
)
::
fileID
INTEGER
,
INTENT
(
INOUT
)
::
currentStarsIndex
,
currentLatharmsIndex
INTEGER
,
INTENT
(
INOUT
)
::
currentStructureIndex
,
currentStepfunctionIndex
LOGICAL
,
INTENT
(
OUT
)
::
l_storeIndices
TYPE
(
t_stars
)
::
starsTemp
TYPE
(
t_vacuum
)
::
vacuumTemp
TYPE
(
t_atoms
)
::
atomsTemp
TYPE
(
t_sphhar
)
::
latharmsTemp
TYPE
(
t_input
)
::
inputTemp
TYPE
(
t_sym
)
::
symTemp
TYPE
(
t_cell
)
::
cellTemp
TYPE
(
t_oneD
)
::
oneDTemp
LOGICAL
::
l_same
,
l_writeAll
l_storeIndices
=
.FALSE.
l_writeAll
=
.FALSE.
IF
(
currentStructureIndex
.EQ.
0
)
THEN
currentStructureIndex
=
1
l_storeIndices
=
.TRUE.
CALL
writeStructureHDF
(
fileID
,
input
,
atoms
,
cell
,
vacuum
,
oneD
,
currentStructureIndex
)
ELSE
CALL
readStructureHDF
(
fileID
,
inputTemp
,
atomsTemp
,
cellTemp
,
vacuumTemp
,
oneDTemp
,
currentStructureIndex
)
CALL
compareStructure
(
atoms
,
vacuum
,
cell
,
atomsTemp
,
vacuumTemp
,
cellTemp
,
l_same
)
IF
(
.NOT.
l_same
)
THEN
currentStructureIndex
=
currentStructureIndex
+
1
l_storeIndices
=
.TRUE.
l_writeAll
=
.TRUE.
CALL
writeStructureHDF
(
fileID
,
input
,
atoms
,
cell
,
vacuum
,
oneD
,
currentStructureIndex
)
END
IF
END
IF
IF
(
currentStarsIndex
.EQ.
0
)
THEN
currentStarsIndex
=
1
l_storeIndices
=
.TRUE.
CALL
writeStarsHDF
(
fileID
,
currentStarsIndex
,
stars
)
ELSE
CALL
readStarsHDF
(
fileID
,
currentStarsIndex
,
starsTemp
)
CALL
compareStars
(
stars
,
starsTemp
,
l_same
)
IF
((
.NOT.
l_same
)
.OR.
l_writeAll
)
THEN
currentStarsIndex
=
currentStarsIndex
+
1
l_storeIndices
=
.TRUE.
CALL
writeStarsHDF
(
fileID
,
currentStarsIndex
,
stars
)
END
IF
END
IF
IF
(
currentLatharmsIndex
.EQ.
0
)
THEN
currentLatharmsIndex
=
1
l_storeIndices
=
.TRUE.
CALL
writeLatharmsHDF
(
fileID
,
currentLatharmsIndex
,
latharms
)
ELSE
CALL
readLatharmsHDF
(
fileID
,
currentLatharmsIndex
,
latharmsTemp
)
CALL
compareLatharms
(
latharms
,
latharmsTemp
,
l_same
)
IF
((
.NOT.
l_same
)
.OR.
l_writeAll
)
THEN
currentLatharmsIndex
=
currentLatharmsIndex
+
1
l_storeIndices
=
.TRUE.
CALL
writeLatharmsHDF
(
fileID
,
currentLatharmsIndex
,
latharms
)
END
IF
END
IF
IF
(
currentStepfunctionIndex
.EQ.
0
)
THEN
currentStepfunctionIndex
=
1
l_storeIndices
=
.TRUE.
CALL
writeStepfunctionHDF
(
fileID
,
currentStepfunctionIndex
,
currentStarsIndex
,
stars
)
ELSE
CALL
readStepfunctionHDF
(
fileID
,
currentStepfunctionIndex
,
starsTemp
)
CALL
compareStepfunctions
(
stars
,
starsTemp
,
l_same
)
IF
((
.NOT.
l_same
)
.OR.
l_writeAll
)
THEN
currentStepfunctionIndex
=
currentStepfunctionIndex
+
1
l_storeIndices
=
.TRUE.
CALL
writeStepfunctionHDF
(
fileID
,
currentStepfunctionIndex
,
currentStarsIndex
,
stars
)
END
IF
END
IF
END
SUBROUTINE
checkAndWriteMetadataHDF
#endif
END
MODULE
m_cdnpot_io_common
io/cdnpot_io_hdf.F90
View file @
a818b405
...
...
@@ -1289,11 +1289,14 @@ MODULE m_cdnpot_io_hdf
INTEGER
::
ntype
,
jmtd
,
nmzd
,
nmzxyd
,
nlhd
,
ng3
,
ng2
INTEGER
::
nmz
,
nvac
,
od_nq2
,
nmzxy
INTEGER
::
hdfError
LOGICAL
::
l_film
,
l_exist
LOGICAL
::
l_film
,
l_exist
,
l_delete
INTEGER
(
HID_T
)
::
archiveID
,
groupID
CHARACTER
(
LEN
=
30
)
::
groupName
,
densityTypeName
INTEGER
(
HSIZE_T
)
::
dims
(
7
)
INTEGER
::
dimsInt
(
7
)
INTEGER
::
starsIndexTemp
,
latharmsIndexTemp
INTEGER
::
structureIndexTemp
,
stepfunctionIndexTemp
INTEGER
::
jspinsTemp
INTEGER
(
HID_T
)
::
frSpaceID
,
frSetID
INTEGER
(
HID_T
)
::
fpwSpaceID
,
fpwSetID
...
...
@@ -1303,6 +1306,8 @@ MODULE m_cdnpot_io_hdf
INTEGER
(
HID_T
)
::
cdomvzSpaceID
,
cdomvzSetID
INTEGER
(
HID_T
)
::
cdomvxySpaceID
,
cdomvxySetID
WRITE
(
*
,
*
)
'writeDensity - start'
WRITE
(
groupname
,
'(a,i0)'
)
'/structure-'
,
structureIndex
l_exist
=
io_groupexists
(
fileID
,
TRIM
(
ADJUSTL
(
groupName
)))
IF
(
.NOT.
l_exist
)
THEN
...
...
@@ -1358,6 +1363,30 @@ MODULE m_cdnpot_io_hdf
groupName
=
TRIM
(
ADJUSTL
(
archiveName
))//
TRIM
(
ADJUSTL
(
densityTypeName
))
l_delete
=
.FALSE.
IF
(
l_exist
)
THEN
CALL
h5gopen_f
(
fileID
,
TRIM
(
ADJUSTL
(
archiveName
)),
archiveID
,
hdfError
)
CALL
io_read_attint0
(
archiveID
,
'starsIndex'
,
starsIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'latharmsIndex'
,
latharmsIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'structureIndex'
,
structureIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'stepfunctionIndex'
,
stepfunctionIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'spins'
,
jspinsTemp
)
IF
(
starsIndex
.NE.
starsIndexTemp
)
l_delete
=
.TRUE.
IF
(
latharmsIndex
.NE.
latharmsIndexTemp
)
l_delete
=
.TRUE.
IF
(
structureIndex
.NE.
structureIndexTemp
)
l_delete
=
.TRUE.
IF
(
stepfunctionIndex
.NE.
stepfunctionIndexTemp
)
l_delete
=
.TRUE.
IF
(
input
%
jspins
.NE.
jspinsTemp
)
l_delete
=
.TRUE.
CALL
h5gclose_f
(
archiveID
,
hdfError
)
END
IF
IF
(
l_delete
)
THEN
CALL
h5ldelete_f
(
fileID
,
archiveName
,
hdfError
)
l_exist
=
.FALSE.
END
IF
IF
(
l_exist
)
THEN
CALL
h5gopen_f
(
fileID
,
TRIM
(
ADJUSTL
(
archiveName
)),
archiveID
,
hdfError
)
...
...
@@ -1586,6 +1615,8 @@ MODULE m_cdnpot_io_hdf
CALL
h5gclose_f
(
archiveID
,
hdfError
)
END
IF
WRITE
(
*
,
*
)
'writeDensity - end'
END
SUBROUTINE
writeDensityHDF
SUBROUTINE
writePotentialHDF
(
input
,
fileID
,
archiveName
,
potentialType
,&
...
...
@@ -1609,17 +1640,23 @@ MODULE m_cdnpot_io_hdf
INTEGER
::
ntype
,
jmtd
,
nmzd
,
nmzxyd
,
nlhd
,
ng3
,
ng2
INTEGER
::
nmz
,
nvac
,
od_nq2
,
nmzxy
INTEGER
::
hdfError
LOGICAL
::
l_film
,
l_exist
LOGICAL
::
l_film
,
l_exist
,
l_delete
INTEGER
(
HID_T
)
::
archiveID
,
groupID
CHARACTER
(
LEN
=
30
)
::
groupName
,
potentialTypeName
INTEGER
(
HSIZE_T
)
::
dims
(
7
)
INTEGER
::
dimsInt
(
7
)
INTEGER
::
starsIndexTemp
,
latharmsIndexTemp
INTEGER
::
structureIndexTemp
,
stepfunctionIndexTemp
INTEGER
::
jspinsTemp
INTEGER
(
HID_T
)
::
frSpaceID
,
frSetID
INTEGER
(
HID_T
)
::
fpwSpaceID
,
fpwSetID
INTEGER
(
HID_T
)
::
fzSpaceID
,
fzSetID
INTEGER
(
HID_T
)
::
fzxySpaceID
,
fzxySetID
WRITE
(
*
,
*
)
'writePotential - start'
WRITE
(
groupname
,
'(a,i0)'
)
'/structure-'
,
structureIndex
l_exist
=
io_groupexists
(
fileID
,
TRIM
(
ADJUSTL
(
groupName
)))
IF
(
.NOT.
l_exist
)
THEN
...
...
@@ -1669,6 +1706,30 @@ MODULE m_cdnpot_io_hdf
groupName
=
TRIM
(
ADJUSTL
(
archiveName
))//
TRIM
(
ADJUSTL
(
potentialTypeName
))
l_delete
=
.FALSE.
IF
(
l_exist
)
THEN
CALL
h5gopen_f
(
fileID
,
TRIM
(
ADJUSTL
(
archiveName
)),
archiveID
,
hdfError
)
CALL
io_read_attint0
(
archiveID
,
'starsIndex'
,
starsIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'latharmsIndex'
,
latharmsIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'structureIndex'
,
structureIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'stepfunctionIndex'
,
stepfunctionIndexTemp
)
CALL
io_read_attint0
(
archiveID
,
'spins'
,
jspinsTemp
)
IF
(
starsIndex
.NE.
starsIndexTemp
)
l_delete
=
.TRUE.
IF
(
latharmsIndex
.NE.
latharmsIndexTemp
)
l_delete
=
.TRUE.
IF
(
structureIndex
.NE.
structureIndexTemp
)
l_delete
=
.TRUE.
IF
(
stepfunctionIndex
.NE.
stepfunctionIndexTemp
)
l_delete
=
.TRUE.
IF
(
input
%
jspins
.NE.
jspinsTemp
)
l_delete
=
.TRUE.
CALL
h5gclose_f
(
archiveID
,
hdfError
)
END
IF
IF
(
l_delete
)
THEN
CALL
h5ldelete_f
(
fileID
,
archiveName
,
hdfError
)
l_exist
=
.FALSE.
END
IF
IF
(
l_exist
)
THEN
CALL
h5gopen_f
(
fileID
,
TRIM
(
ADJUSTL
(
archiveName
)),
archiveID
,
hdfError
)
...
...
@@ -1799,11 +1860,13 @@ MODULE m_cdnpot_io_hdf
CALL
h5gclose_f
(
archiveID
,
hdfError
)
END
IF
WRITE
(
*
,
*
)
'writePotential - end'
END
SUBROUTINE
writePotentialHDF
SUBROUTINE
readDensityHDF
(
fileID
,
input
,
stars
,
latharms
,
atoms
,
vacuum
,
oneD
,&
archiveName
,
densityType
,&
fermiEnergy
,
l_qfix
,
iter
,
fr
,
fpw
,
fz
,
fzxy
,
cdom
,
cdomvz
,
cdomvxy
)
fermiEnergy
,
l_qfix
,
l_DimChange
,
iter
,
fr
,
fpw
,
fz
,
fzxy
,
cdom
,
cdomvz
,
cdomvxy
)
TYPE
(
t_input
),
INTENT
(
IN
)
::
input
TYPE
(
t_stars
),
INTENT
(
IN
)
::
stars
...
...
@@ -1818,7 +1881,7 @@ MODULE m_cdnpot_io_hdf
INTEGER
,
INTENT
(
OUT
)
::
iter
REAL
,
INTENT
(
OUT
)
::
fermiEnergy
LOGICAL
,
INTENT
(
OUT
)
::
l_qfix
LOGICAL
,
INTENT
(
OUT
)
::
l_qfix
,
l_DimChange
REAL
,
INTENT
(
OUT
)
::
fr
(:,:,:,:)
REAL
,
INTENT
(
OUT
)
::
fz
(:,:,:)
...
...
@@ -1826,29 +1889,39 @@ MODULE m_cdnpot_io_hdf
COMPLEX
,
INTENT
(
OUT
)
::
fzxy
(:,:,:,:)
COMPLEX
,
INTENT
(
OUT
)
::
cdom
(:),
cdomvz
(:,:),
cdomvxy
(:,:,:)
INTEGER
::
starsIndex
,
latharmsIndex
,
structureIndex
,
stepfunctionIndex
INTEGER
::
previousDensityIndex
,
jspins
INTEGER
::
ntype
,
jmtd
,
nmzd
,
nmzxyd
,
nlhd
,
ng3
,
ng2
INTEGER
::
nmz
,
nvac
,
od_nq2
,
nmzxy
INTEGER
::
localDensityType
LOGICAL
::
l_film
,
l_exist
INTEGER
(
HID_T
)
::
archiveID
,
groupID
,
groupBID
INTEGER
::
hdfError
CHARACTER
(
LEN
=
30
)
::
groupName
,
groupBName
,
densityTypeName
INTEGER
::
dimsInt
(
7
)
INTEGER
(
HID_T
)
::
frSetID
INTEGER
(
HID_T
)
::
fpwSetID
INTEGER
(
HID_T
)
::
fzSetID
INTEGER
(
HID_T
)
::
fzxySetID
INTEGER
(
HID_T
)
::
cdomSetID
INTEGER
(
HID_T
)
::
cdomvzSetID
INTEGER
(
HID_T
)
::
cdomvxySetID
INTEGER
::
starsIndex
,
latharmsIndex
,
structureIndex
,
stepfunctionIndex
INTEGER
::
previousDensityIndex
,
jspins
INTEGER
::
ntype
,
jmtd
,
nmzd
,
nmzxyd
,
nlhd
,
ng3
,
ng2
INTEGER
::
nmz
,
nvac
,
od_nq2
,
nmzxy
INTEGER
::
localDensityType
LOGICAL
::
l_film
,
l_exist
INTEGER
(
HID_T
)
::
archiveID
,
groupID
,
groupBID
INTEGER
::
hdfError
CHARACTER
(
LEN
=
30
)
::
groupName
,
groupBName
,
densityTypeName
INTEGER
::
dimsInt
(
7
)
INTEGER
::
jmtdOut
,
ntypeOut
,
nmzdOut
,
nmzxydOut
,
nlhdOut
,
ng3Out
,
ng2Out
INTEGER
::
nmzOut
,
nvacOut
,
od_nq2Out
,
nmzxyOut
,
jspinsOut
INTEGER
(
HID_T
)
::
frSetID
INTEGER
(
HID_T
)
::
fpwSetID
INTEGER
(
HID_T
)
::
fzSetID
INTEGER
(
HID_T
)
::
fzxySetID
INTEGER
(
HID_T
)
::
cdomSetID
INTEGER
(
HID_T
)
::
cdomvzSetID
INTEGER
(
HID_T
)
::
cdomvxySetID
REAL
,
ALLOCATABLE
::
frTemp
(:,:,:,:)
REAL
,
ALLOCATABLE
::
fzTemp
(:,:,:)
COMPLEX
,
ALLOCATABLE
::
fpwTemp
(:,:)
COMPLEX
,
ALLOCATABLE
::
fzxyTemp
(:,:,:,:)
COMPLEX
,
ALLOCATABLE
::
cdomTemp
(:),
cdomvzTemp
(:,:),
cdomvxyTemp
(:,:,:)
cdom
=
CMPLX
(
0.0
,
0.0
)
cdomvz
=
CMPLX
(
0.0
,
0.0
)
cdomvxy
=
CMPLX
(
0.0
,
0.0
)
WRITE
(
*
,
*
)
'readDensity - start'
l_exist
=
io_groupexists
(
fileID
,
TRIM
(
ADJUSTL
(
archiveName
)))
IF
(
.NOT.
l_exist
)
THEN
CALL
juDFT_error
(
'density archive '
//
TRIM
(
ADJUSTL
(
archiveName
))//
' does not exist.'
,
calledby
=
"readDensityHDF"
)
...
...
@@ -1938,59 +2011,112 @@ MODULE m_cdnpot_io_hdf
CALL
io_read_attreal0
(
groupID
,
'fermiEnergy'
,
fermiEnergy
)
CALL
io_read_attlog0
(
groupID
,
'l_qfix'
,
l_qfix
)
jmtdOut
=
MIN
(
jmtd
,
atoms
%
jmtd
)
ntypeOut
=
MIN
(
ntype
,
atoms
%
ntype
)
nmzdOut
=
MIN
(
nmzd
,
vacuum
%
nmzd
)
nmzxydOut
=
MIN
(
nmzxyd
,
vacuum
%
nmzxyd
)
nlhdOut
=
MIN
(
nlhd
,
latharms
%
nlhd
)
ng3Out
=
MIN
(
ng3
,
stars
%
ng3
)
ng2Out
=
MIN
(
ng2
,
stars
%
ng2
)
nmzOut
=
MIN
(
nmz
,
vacuum
%
nmz
)
nvacOut
=
MIN
(
nvac
,
vacuum
%
nvac
)
od_nq2Out
=
MIN
(
od_nq2
,
oneD
%
odi
%
nq2
)
nmzxyOut
=
MIN
(
nmzxy
,
vacuum
%
nmzxy
)
jsp