Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
S
src
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
6
Issues
6
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Analytics
Analytics
CI / CD
Code Review
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
H5hut
src
Commits
4f423dbd
Commit
4f423dbd
authored
Sep 21, 2006
by
gsell
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
test/H5BlockTestAttributesF.f90
- more coding
parent
624edd3b
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
127 additions
and
38 deletions
+127
-38
test/H5BlockTestAttributesF.f90
test/H5BlockTestAttributesF.f90
+127
-38
No files found.
test/H5BlockTestAttributesF.f90
View file @
4f423dbd
PROGRAM
H5BlockTestAttributesF
IMPLICIT
NONE
INCLUDE
'mpif.h'
INCLUDE
'H5PartF90.inc'
INCLUDE
'H5BlockF90.inc'
INTERFACE
INTEGER
*
8
FUNCTION
write_file
(
fname
,
myproc
,
comm
,
layout
)
CHARACTER
(
LEN
=*
),
INTENT
(
IN
)
::
fname
INTEGER
,
INTENT
(
IN
)
::
myproc
INTEGER
,
INTENT
(
IN
)
::
comm
INTEGER
*
8
,
INTENT
(
IN
)
::
layout
(
6
)
END
FUNCTION
INTEGER
*
8
FUNCTION
read_file
(
fname
,
myproc
,
comm
,
layout
)
CHARACTER
(
LEN
=*
),
INTENT
(
IN
)
::
fname
INTEGER
,
INTENT
(
IN
)
::
myproc
INTEGER
,
INTENT
(
IN
)
::
comm
INTEGER
*
8
,
INTENT
(
IN
)
::
layout
(
6
)
END
FUNCTION
END
INTERFACE
INTEGER
::
myproc
INTEGER
::
nprocs
INTEGER
::
mpi_err
INTEGER
::
myproc
=
0
INTEGER
::
nprocs
=
1
INTEGER
*
8
::
h5pt_err
INTEGER
::
comm
INTEGER
::
i
CHARACTER
(
LEN
=
32
)
::
arg_str
LOGICAL
::
opt_read
LOGICAL
::
opt_write
INTEGER
*
8
::
layout
(
6
)
! = ( 0, 64, 0, 64, 0, 512 )
CALL
MPI_Init
(
mpi_err
)
comm
=
MPI_COMM_WORLD
CALL
MPI_Comm_rank
(
comm
,
myproc
,
mpi_err
)
CALL
MPI_Comm_size
(
comm
,
nprocs
,
mpi_err
)
INTEGER
::
opt_read
=
0
INTEGER
::
opt_write
=
0
INTEGER
*
8
::
layout
(
6
)
DATA
layout
/
1
,
64
,
1
,
64
,
1
,
512
/
DO
i
=
1
,
IARGC
()
CALL
GETARG
(
i
,
arg_str
,
32
)
CALL
GETARG
(
i
,
arg_str
)
PRINT
*
,
arg_str
IF
(
arg_str
==
"-r"
)
THEN
opt_read
=
.TRUE.
PRINT
*
,
"Reading file"
opt_read
=
1
ELSE
IF
(
arg_str
==
"-w"
)
THEN
opt_write
=
.TRUE.
opt_write
=
1
ELSE
PRINT
*
,
"Illegal option "
,
arg_str
,
"\n"
PRINT
*
,
"Usage: H5BlockTestAttributesF -w | -r"
...
...
@@ -52,11 +31,121 @@ PROGRAM H5BlockTestAttributesF
h5pt_err
=
h5pt_set_verbosity_level
(
4_8
)
IF
(
opt_write
)
THEN
h5pt_err
=
write_file
(
"blockfile0.h5"
,
myproc
,
comm
,
layout
)
ELSE
IF
(
opt_read
)
THEN
h5pt_err
=
read_file
(
"blockfile0.h5"
,
myproc
,
comm
,
layout
)
IF
(
opt_write
==
1
)
THEN
h5pt_err
=
write_file
(
"blockfile0.h5"
,
myproc
,
layout
)
ELSE
IF
(
opt_read
==
1
)
THEN
PRINT
*
,
"Calling read_file"
h5pt_err
=
read_file
(
"blockfile0.h5"
,
myproc
,
layout
)
ENDIF
CALL
MPI_Finalize
()
CONTAINS
INTEGER
*
8
FUNCTION
write_file
(
fname
,
myproc
,
layout
)
CHARACTER
(
LEN
=*
),
INTENT
(
IN
)
::
fname
INTEGER
,
INTENT
(
IN
)
::
myproc
INTEGER
*
8
,
INTENT
(
IN
)
::
layout
(
6
)
write_file
=
0
END
FUNCTION
write_file
INTEGER
*
8
FUNCTION
read_file
(
fname
,
myproc
,
layout
)
CHARACTER
(
LEN
=*
),
INTENT
(
IN
)
::
fname
INTEGER
,
INTENT
(
IN
)
::
myproc
INTEGER
*
8
,
INTENT
(
IN
)
::
layout
(
6
)
INTEGER
*
8
::
file
INTEGER
*
8
::
timestep
=
1
PRINT
*
,
"PROC["
,
myproc
,
"]: Open file "
,
fname
,
" for reading ..."
file
=
h5pt_openr
(
fname
)
if
(
file
==
0
)
THEN
read_file
=
-1
RETURN
ENDIF
PRINT
*
,
"file: "
,
file
h5pt_err
=
h5pt_setstep
(
file
,
timestep
)
IF
(
h5pt_err
<
0
)
THEN
read_file
=
-1
RETURN
ENDIF
h5pt_err
=
read_field
(
file
,
myproc
,
layout
)
IF
(
h5pt_err
<
0
)
THEN
read_file
=
-1
RETURN
ENDIF
h5pt_err
=
h5pt_close
(
file
)
IF
(
h5pt_err
<
0
)
THEN
read_file
=
-1
RETURN
ENDIF
read_file
=
0
END
FUNCTION
read_file
INTEGER
*
8
FUNCTION
read_field
(
file
,
myproc
,
layout
)
INTEGER
*
8
,
INTENT
(
IN
)
::
file
INTEGER
,
INTENT
(
IN
)
::
myproc
INTEGER
*
8
,
INTENT
(
IN
)
::
layout
(
6
)
INTEGER
*
8
::
i
,
j
,
k
INTEGER
*
8
::
i_start
INTEGER
*
8
::
i_end
INTEGER
*
8
::
j_start
INTEGER
*
8
::
j_end
INTEGER
*
8
::
k_start
INTEGER
*
8
::
k_end
INTEGER
*
8
::
i_dims
INTEGER
*
8
::
j_dims
INTEGER
*
8
::
k_dims
REAL
*
8
::
value
INTEGER
*
8
data
(
64
,
64
,
512
)
PRINT
*
,
"Reading field ..."
i_start
=
layout
(
1
)
i_end
=
layout
(
2
)
j_start
=
layout
(
3
)
j_end
=
layout
(
4
)
k_start
=
layout
(
5
)
k_end
=
layout
(
6
)
i_dims
=
i_end
-
i_start
+
1
j_dims
=
j_end
-
j_start
+
1
k_dims
=
k_end
-
k_start
+
1
PRINT
*
,
"dims: ("
,
i_dims
,
j_dims
,
k_dims
,
")"
!ALLOCATE ( data ( i_dims, j_dims, k_dims ) )
PRINT
*
,
"Defining Layout ..."
h5pt_err
=
h5bl_define3dlayout
(
file
,
i_start
,
i_end
,
j_start
,
j_end
,
k_start
,
k_end
)
IF
(
h5pt_err
<
0
)
THEN
read_field
=
-1
RETURN
END
IF
PRINT
*
,
"Reading field ..."
h5pt_err
=
h5bl_3d_read_scalar_field
(
file
,
"TestField"
,
data
)
IF
(
h5pt_err
<
0
)
THEN
read_field
=
-1
RETURN
END
IF
DO
i
=
1
,
i_dims
DO
j
=
1
,
j_dims
DO
k
=
1
,
k_dims
value
=
k
+
1000
*
j
+
100000
*
i
if
(
data
(
i
,
j
,
k
)
/
=
value
)
THEN
PRINT
*
,
"data("
,
i
,
","
,
j
,
","
,
k
,
") = "
,
data
(
i
,
j
,
k
),
" /= "
,
value
END
IF
END
DO
END
DO
END
DO
read_field
=
0
END
FUNCTION
read_field
END
PROGRAM
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