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
6c45da63
Commit
6c45da63
authored
May 18, 2020
by
Matthias Redies
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
cleanup eig66_data
parent
c00cd83c
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
163 additions
and
165 deletions
+163
-165
io/eig66_data.F90
io/eig66_data.F90
+163
-165
No files found.
io/eig66_data.F90
View file @
6c45da63
...
...
@@ -7,182 +7,180 @@
module
m_eig66_data
#include "juDFT_env.h"
#ifdef CPP_HDF
use
hdf5
use
hdf5
#endif
implicit
none
TYPE
::
t_data
INTEGER
::
io_mode
INTEGER
::
jspins
,
nkpts
,
nmat
,
neig
,
nlo
,
ntype
LOGICAL
::
l_real
,
l_soc
END
TYPE
TYPE
,
EXTENDS
(
t_data
)::
t_data_DA
INTEGER
::
recl_vec
=
0
,
recl_wiks
CHARACTER
(
LEN
=
20
)
::
fname
=
"eig"
INTEGER
::
file_io_id_vec
,
file_io_id_wiks
END
TYPE
TYPE
,
extends
(
t_data
)::
t_data_MPI
LOGICAL
::
read_epoch
=
.false.
INTEGER
::
n_size
=
1
INTEGER
::
size_k
,
size_eig
INTEGER
::
eig_handle
,
zr_handle
,
zc_handle
,
neig_handle
,
w_iks_handle
INTEGER
,
ALLOCATABLE
::
pe_basis
(:,:),
slot_basis
(:,
:)
INTEGER
,
ALLOCATABLE
::
pe_ev
(:,:,:),
slot_ev
(:,:,
:)
INTEGER
::
irank
INTEGER
,
POINTER
::
neig_data
(:)
REAL
,
POINTER
::
eig_data
(:),
zr_data
(:),
w_iks_data
(:)
COMPLEX
,
POINTER
::
zc_data
(:)
END
TYPE
TYPE
,
EXTENDS
(
t_data
)::
t_data_hdf
implicit
none
TYPE
::
t_data
INTEGER
::
io_mode
INTEGER
::
jspins
,
nkpts
,
nmat
,
neig
,
nlo
,
ntype
LOGICAL
::
l_real
,
l_soc
END
TYPE
TYPE
,
EXTENDS
(
t_data
)::
t_data_DA
INTEGER
::
recl_vec
=
0
,
recl_wiks
CHARACTER
(
LEN
=
20
)
::
fname
=
"eig"
INTEGER
::
file_io_id_vec
,
file_io_id_wiks
END
TYPE
TYPE
,
extends
(
t_data
)::
t_data_MPI
LOGICAL
::
read_epoch
=
.false.
INTEGER
::
n_size
=
1
INTEGER
::
size_k
,
size_eig
INTEGER
::
eig_handle
,
zr_handle
,
zc_handle
,
neig_handle
,
w_iks_handle
INTEGER
,
ALLOCATABLE
::
pe_basis
(:,
:),
slot_basis
(:,
:)
INTEGER
,
ALLOCATABLE
::
pe_ev
(:,
:,
:),
slot_ev
(:,
:,
:)
INTEGER
::
irank
INTEGER
,
POINTER
::
neig_data
(:)
REAL
,
POINTER
::
eig_data
(:),
zr_data
(:),
w_iks_data
(:)
COMPLEX
,
POINTER
::
zc_data
(:)
END
TYPE
TYPE
,
EXTENDS
(
t_data
)::
t_data_hdf
#ifdef CPP_HDF
INTEGER
(
HID_T
)
::
fid
INTEGER
(
HID_T
)
::
neigsetid
INTEGER
(
HID_T
)
::
energysetid
,
wikssetid
,
evsetid
CHARACTER
(
LEN
=
20
)
::
fname
=
"eig"
INTEGER
(
HID_T
)
::
fid
INTEGER
(
HID_T
)
::
neigsetid
INTEGER
(
HID_T
)
::
energysetid
,
wikssetid
,
evsetid
CHARACTER
(
LEN
=
20
)
::
fname
=
"eig"
#endif
END
TYPE
TYPE
,
EXTENDS
(
t_data
)::
t_data_mem
INTEGER
,
ALLOCATABLE
::
eig_int
(:)
REAL
,
ALLOCATABLE
::
eig_eig
(:,:,:)
REAL
,
ALLOCATABLE
::
eig_vecr
(:,:)
COMPLEX
,
ALLOCATABLE
::
eig_vecc
(:,:)
END
TYPE
TYPE
t_list
INTEGER
::
id
CLASS
(
t_data
),
POINTER
::
data
TYPE
(
t_list
),
POINTER
::
next
=>
null
()
END
TYPE
TYPE
(
t_list
),
POINTER
::
linked_list
=>
null
()
private
linked_list
INTEGER
,
PARAMETER
::
DA_mode
=
0
,
HDF_mode
=
1
,
MEM_mode
=
2
,
MPI_mode
=
3
contains
subroutine
eig66_data_storedefault
(
d
,
jspins
,
nkpts
,
nmat
,
neig
,
l_real
,
l_soc
)
CLASS
(
t_data
)::
d
INTEGER
,
INTENT
(
IN
)::
jspins
,
nkpts
,
nmat
,
neig
LOGICAL
,
INTENT
(
IN
)::
l_real
,
l_soc
d
%
jspins
=
jspins
d
%
nkpts
=
nkpts
d
%
nmat
=
nmat
d
%
neig
=
neig
d
%
l_real
=
l_real
d
%
l_soc
=
l_soc
END
SUBROUTINE
subroutine
eig66_find_data
(
d
,
id
,
io_mode
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
INTEGER
,
INTENT
(
IN
),
OPTIONAL
::
io_mode
CLASS
(
t_data
),
pointer
::
d
TYPE
(
t_list
),
POINTER
,
ASYNCHRONOUS
::
listpointer
,
lastinlist
lastinlist
=>
null
()
listpointer
=>
linked_list
DO
WHILE
(
associated
(
listpointer
))
lastinlist
=>
listpointer
if
(
listpointer
%
id
==
id
)
THEN
d
=>
listpointer
%
data
return
endif
listpointer
=>
listpointer
%
next
enddo
!no pointer found
IF
(
present
(
io_mode
))
THEN
IF
(
.not.
associated
(
lastinlist
))
THEN
allocate
(
linked_list
)
linked_list
%
id
=
id
lastinlist
=>
linked_list
ELSE
allocate
(
lastinlist
%
next
)
lastinlist
%
next
%
id
=
id
lastinlist
=>
lastinlist
%
next
ENDIF
SELECT
CASE
(
io_mode
)
END
TYPE
TYPE
,
EXTENDS
(
t_data
)::
t_data_mem
INTEGER
,
ALLOCATABLE
::
eig_int
(:)
REAL
,
ALLOCATABLE
::
eig_eig
(:,
:,
:)
REAL
,
ALLOCATABLE
::
eig_vecr
(:,
:)
COMPLEX
,
ALLOCATABLE
::
eig_vecc
(:,
:)
END
TYPE
TYPE
t_list
INTEGER
::
id
CLASS
(
t_data
),
POINTER
::
data
TYPE
(
t_list
),
POINTER
::
next
=>
null
()
END
TYPE
TYPE
(
t_list
),
POINTER
::
linked_list
=>
null
()
private
linked_list
INTEGER
,
PARAMETER
::
DA_mode
=
0
,
HDF_mode
=
1
,
MEM_mode
=
2
,
MPI_mode
=
3
contains
subroutine
eig66_data_storedefault
(
d
,
jspins
,
nkpts
,
nmat
,
neig
,
l_real
,
l_soc
)
CLASS
(
t_data
)::
d
INTEGER
,
INTENT
(
IN
)::
jspins
,
nkpts
,
nmat
,
neig
LOGICAL
,
INTENT
(
IN
)::
l_real
,
l_soc
d
%
jspins
=
jspins
d
%
nkpts
=
nkpts
d
%
nmat
=
nmat
d
%
neig
=
neig
d
%
l_real
=
l_real
d
%
l_soc
=
l_soc
END
SUBROUTINE
subroutine
eig66_find_data
(
d
,
id
,
io_mode
)
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
id
INTEGER
,
INTENT
(
IN
),
OPTIONAL
::
io_mode
CLASS
(
t_data
),
pointer
::
d
TYPE
(
t_list
),
POINTER
,
ASYNCHRONOUS
::
listpointer
,
lastinlist
lastinlist
=>
null
()
listpointer
=>
linked_list
DO
WHILE
(
associated
(
listpointer
))
lastinlist
=>
listpointer
if
(
listpointer
%
id
==
id
)
THEN
d
=>
listpointer
%
data
return
endif
listpointer
=>
listpointer
%
next
enddo
!no pointer found
IF
(
present
(
io_mode
))
THEN
IF
(
.not.
associated
(
lastinlist
))
THEN
allocate
(
linked_list
)
linked_list
%
id
=
id
lastinlist
=>
linked_list
ELSE
allocate
(
lastinlist
%
next
)
lastinlist
%
next
%
id
=
id
lastinlist
=>
lastinlist
%
next
ENDIF
SELECT
CASE
(
io_mode
)
case
(
DA_MODE
)
allocate
(
t_data_DA
::
lastinlist
%
data
)
allocate
(
t_data_DA
::
lastinlist
%
data
)
case
(
HDF_MODE
)
#ifdef CPP_HDF
allocate
(
t_data_HDF
::
lastinlist
%
data
)
allocate
(
t_data_HDF
::
lastinlist
%
data
)
#else
call
juDFT_error
(
"Cannot use hdf mode for IO, recompile with CPP_HDF"
,
calledby
=
"eig66_data"
)
call
juDFT_error
(
"Cannot use hdf mode for IO, recompile with CPP_HDF"
,
calledby
=
"eig66_data"
)
#endif
case
(
MEM_MODE
)
allocate
(
t_data_MEM
::
lastinlist
%
data
)
allocate
(
t_data_MEM
::
lastinlist
%
data
)
case
(
MPI_MODE
)
allocate
(
t_data_MPI
::
lastinlist
%
data
)
allocate
(
t_data_MPI
::
lastinlist
%
data
)
end
select
lastinlist
%
data
%
io_mode
=
io_mode
d
=>
lastinlist
%
data
ELSE
call
juDFT_error
(
"BUG:Could not find data object in eig66_mpi"
)
ENDIF
END
SUBROUTINE
subroutine
eig66_remove_data
(
id
)
INTEGER
,
INTENT
(
IN
)::
id
TYPE
(
t_list
),
POINTER
::
listpointer
,
lastpointer
lastpointer
=>
null
()
listpointer
=>
linked_list
loop
:
DO
WHILE
(
associated
(
listpointer
))
IF
(
listpointer
%
id
==
id
)
THEN
exit
loop
lastinlist
%
data
%
io_mode
=
io_mode
d
=>
lastinlist
%
data
ELSE
call
juDFT_error
(
"BUG:Could not find data object in eig66_mpi"
)
ENDIF
lastpointer
=>
listpointer
listpointer
=>
listpointer
%
next
ENDDO
loop
if
(
.not.
associated
(
listpointer
))
call
juDFT_error
(
"BUG in eig66_data: ID not found in deleting"
)
IF
(
associated
(
lastpointer
))
THEN
lastpointer
%
next
=>
listpointer
%
next
ELSE
linked_list
=>
listpointer
%
next
ENDIF
deallocate
(
listpointer
)
end
subroutine
INTEGER
FUNCTION
eig66_data_newid
(
mode
)
INTEGER
,
INTENT
(
IN
)
::
mode
TYPE
(
t_list
),
POINTER
::
listpointer
INTEGER
::
id
CLASS
(
t_data
),
POINTER
::
d
id
=
0
listpointer
=>
linked_list
DO
WHILE
(
associated
(
listpointer
))
id
=
max
(
id
,
listpointer
%
id
)
listpointer
=>
listpointer
%
next
ENDDO
eig66_data_newid
=
id
+1
call
eig66_find_data
(
d
,
id
+1
,
mode
)
end
function
INTEGER
function
eig66_data_mode
(
id
)
RESULT
(
mode
)
INTEGER
,
INTENT
(
IN
)
::
id
TYPE
(
t_list
),
POINTER
::
listpointer
mode
=
-1
listpointer
=>
linked_list
DO
WHILE
(
associated
(
listpointer
))
if
(
id
==
listpointer
%
id
)
THEN
mode
=
listpointer
%
data
%
io_mode
return
ENDIF
listpointer
=>
listpointer
%
next
ENDDO
END
FUNCTION
END
SUBROUTINE
subroutine
eig66_remove_data
(
id
)
INTEGER
,
INTENT
(
IN
)::
id
TYPE
(
t_list
),
POINTER
::
listpointer
,
lastpointer
lastpointer
=>
null
()
listpointer
=>
linked_list
loop
:
DO
WHILE
(
associated
(
listpointer
))
IF
(
listpointer
%
id
==
id
)
THEN
exit
loop
ENDIF
lastpointer
=>
listpointer
listpointer
=>
listpointer
%
next
ENDDO
loop
if
(
.not.
associated
(
listpointer
))
call
juDFT_error
(
"BUG in eig66_data: ID not found in deleting"
)
IF
(
associated
(
lastpointer
))
THEN
lastpointer
%
next
=>
listpointer
%
next
ELSE
linked_list
=>
listpointer
%
next
ENDIF
deallocate
(
listpointer
)
end
subroutine
INTEGER
FUNCTION
eig66_data_newid
(
mode
)
INTEGER
,
INTENT
(
IN
)
::
mode
TYPE
(
t_list
),
POINTER
::
listpointer
INTEGER
::
id
CLASS
(
t_data
),
POINTER
::
d
id
=
0
listpointer
=>
linked_list
DO
WHILE
(
associated
(
listpointer
))
id
=
max
(
id
,
listpointer
%
id
)
listpointer
=>
listpointer
%
next
ENDDO
eig66_data_newid
=
id
+
1
call
eig66_find_data
(
d
,
id
+
1
,
mode
)
end
function
INTEGER
function
eig66_data_mode
(
id
)
RESULT
(
mode
)
INTEGER
,
INTENT
(
IN
)
::
id
TYPE
(
t_list
),
POINTER
::
listpointer
mode
=
-1
listpointer
=>
linked_list
DO
WHILE
(
associated
(
listpointer
))
if
(
id
==
listpointer
%
id
)
THEN
mode
=
listpointer
%
data
%
io_mode
return
ENDIF
listpointer
=>
listpointer
%
next
ENDDO
END
FUNCTION
end
module
m_eig66_data
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment