1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
! This file created from f77/attr/attrmpi1f.f with f77tof90
!
! Copyright (C) by Argonne National Laboratory
! See COPYRIGHT in top-level directory
!
program main
use mpi
integer value, wsize, wrank, extra, mykey
integer rvalue, svalue, ncomm
logical flag
integer ierr, errs
!
errs = 0
call mtest_init( ierr )
call mpi_comm_size( MPI_COMM_WORLD, wsize, ierr )
call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
!
! Simple attribute put and get
!
call mpi_keyval_create( MPI_NULL_COPY_FN, MPI_NULL_DELETE_FN, &
& mykey, extra,ierr )
call mpi_attr_get( MPI_COMM_WORLD, mykey, value, flag, ierr )
if (flag) then
errs = errs + 1
print *, &
& "Did not get flag==.false. for attribute that was not set"
endif
!
value = 1234567
svalue = value
call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
value = -9876543
call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
if (.not. flag) then
errs = errs + 1
print *, "Did not find attribute after set"
else
if (rvalue .ne. svalue) then
errs = errs + 1
print *, "Attribute value ", rvalue, " should be ", svalue
endif
endif
value = -123456
svalue = value
call mpi_attr_put( MPI_COMM_WORLD, mykey, value, ierr )
value = 987654
call mpi_attr_get( MPI_COMM_WORLD, mykey, rvalue, flag, ierr )
if (.not. flag) then
errs = errs + 1
print *, "Did not find attribute after set (neg)"
else
if (rvalue .ne. svalue) then
errs = errs + 1
print *, "Neg Attribute value ", rvalue," should be ",svalue
endif
endif
!
call mpi_keyval_free( mykey, ierr )
call mtest_finalize( errs )
end
|
