Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in
Toggle navigation
Menu
Open sidebar
Kim, Jungwon
papyrus
Commits
6670f67c
Commit
6670f67c
authored
May 14, 2018
by
Kim, Jungwon
Browse files
added error msg
parent
f9ab623d
Changes
1
Hide whitespace changes
Inline
Side-by-side
kv/tests/14_fortran/test14_fortran.f90
View file @
6670f67c
...
...
@@ -11,9 +11,9 @@ PROGRAM TEST14_FORTRAN
INTEGER
(
KIND
=
8
)
::
KEYLEN
,
VALLEN
CALL
MPI_INIT_THREAD
(
MPI_THREAD_MULTIPLE
,
PROVIDED
,
IERROR
)
CALL
PAPYRUSKV_INIT
(
'./pkv_repo'
,
IERROR
)
CALL
PAPYRUSKV_INIT
(
'./pkv_repo'
//
CHAR
(
0
)
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT INIT
'
ENDIF
CALL
MPI_COMM_RANK
(
MPI_COMM_WORLD
,
RANK
,
IERROR
)
...
...
@@ -38,9 +38,9 @@ PROGRAM TEST14_FORTRAN
PEER
=
RANK
+
1
ENDIF
CALL
PAPYRUSKV_OPEN
(
'TEST_DB'
,
IOR
(
PAPYRUSKV_CREATE
,
PAPYRUSKV_RDWR
),
DB
,
IERROR
)
CALL
PAPYRUSKV_OPEN
(
'TEST_DB'
//
CHAR
(
0
)
,
IOR
(
PAPYRUSKV_CREATE
,
PAPYRUSKV_RDWR
),
DB
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT OPEN
'
ENDIF
IF
(
RANK
<
SIZE
(
KEY
))
THEN
...
...
@@ -49,60 +49,60 @@ PROGRAM TEST14_FORTRAN
PRINT
*
,
'PUT--> RANK'
,
RANK
,
'KEY:'
,
KEY
(
RANK
)(
1
:
KEYLEN
),
' VAL:'
,
VAL
(
RANK
)(
1
:
VALLEN
)
CALL
PAPYRUSKV_PUT
(
DB
,
KEY
(
RANK
),
KEYLEN
,
VAL
(
RANK
),
VALLEN
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT PUT
'
ENDIF
END
IF
CALL
PAPYRUSKV_BARRIER
(
DB
,
PAPYRUSKV_MEMTABLE
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT BARRIER
'
ENDIF
IF
(
RANK
<
SIZE
(
KEY
))
THEN
CALL
PAPYRUSKV_GET
(
DB
,
KEY
(
RANK
),
KEYLEN
,
VAL1
,
VALLEN
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT GET
'
ENDIF
PRINT
*
,
'GET--> RANK'
,
RANK
,
'KEY:'
,
KEY
(
RANK
)(
1
:
KEYLEN
),
' VAL:'
,
VAL1
(
1
:
VALLEN
)
CALL
PAPYRUSKV_GET
(
DB
,
KEY
(
RANK
),
KEYLEN
,
VAL2
,
VALLEN
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT GET
'
ENDIF
PRINT
*
,
'GET--> RANK'
,
RANK
,
'KEY:'
,
KEY
(
RANK
)(
1
:
KEYLEN
),
' VAL:'
,
VAL2
(
1
:
VALLEN
)
CALL
PAPYRUSKV_FREE
(
VAL2
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT FREE
'
ENDIF
KEYLEN
=
LEN
(
TRIM
(
KEY
(
PEER
)),
KIND
=
8
)
CALL
PAPYRUSKV_GET
(
DB
,
KEY
(
PEER
),
KEYLEN
,
VAL1
,
VALLEN
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT GET
'
ENDIF
PRINT
*
,
'GET--> RANK'
,
RANK
,
'KEY:'
,
KEY
(
PEER
)(
1
:
KEYLEN
),
' VAL:'
,
VAL1
(
1
:
VALLEN
)
CALL
PAPYRUSKV_GET
(
DB
,
KEY
(
PEER
),
KEYLEN
,
VAL2
,
VALLEN
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT GET
'
ENDIF
PRINT
*
,
'GET--> RANK'
,
RANK
,
'KEY:'
,
KEY
(
PEER
)(
1
:
KEYLEN
),
' VAL:'
,
VAL2
(
1
:
VALLEN
)
CALL
PAPYRUSKV_FREE
(
VAL2
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT FREE
'
ENDIF
END
IF
CALL
PAPYRUSKV_CLOSE
(
DB
,
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT CLOSE
'
ENDIF
DEALLOCATE
(
VAL1
)
CALL
PAPYRUSKV_FINALIZE
(
IERROR
)
IF
(
IERROR
/
=
PAPYRUSKV_OK
)
THEN
PRINT
*
,
'FAILED'
PRINT
*
,
'FAILED
AT FINALIZE
'
ENDIF
CALL
MPI_FINALIZE
(
IERROR
)
END
PROGRAM
TEST14_FORTRAN
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