7 integer PM_GLOBAL_ERROR, PM_NUM_NODES
9 parameter (PM_MAX_TESTS=3)
11 integer PM_TEST_INTEGER, fuzzy, Error, FazAttr
13 integer Faz_World, FazTag
15 parameter (PM_TEST_INTEGER=12345)
17 external FazCreate, FazDelete
21 call MPI_INIT(PM_GLOBAL_ERROR)
23 PM_GLOBAL_ERROR = MPI_SUCCESS
24 C. Find out the number of processes
25 call MPI_COMM_SIZE (MPI_COMM_WORLD,PM_NUM_NODES,PM_GLOBAL_ERROR)
26 call MPI_COMM_RANK (MPI_COMM_WORLD,PM_RANK_SELF,PM_GLOBAL_ERROR)
29 call MPI_keyval_create ( FazCreate, FazDelete, FazTag,
32 C. Make sure that we can get an attribute that hasn't been set yet (flag
34 call MPI_attr_get (MPI_COMM_WORLD, FazTag, FazAttr,
39 print *, 'Did not get flag==false when attr_get of key that'
40 print *, 'had not had a value set with attr_put'
44 call MPI_attr_put (MPI_COMM_WORLD, FazTag, FazAttr, Error)
46 C. Check that the put worked
47 call MPI_attr_get (MPI_COMM_WORLD, FazTag, FazAttr,
50 if (FazAttr .ne. 120) then
52 print 1, ' Proc=',PM_Rank_self, ' ATTR=', FazAttr
54 C. Duplicate the Communicator and it's cached attributes
56 call MPI_Comm_Dup (MPI_COMM_WORLD, Faz_WORLD, Error)
59 call MPI_Attr_Get ( Faz_WORLD, FazTag, FazAttr,
63 if (FazAttr .ne. 121) then
65 print 1, ' T-Flag, Proc=',PM_Rank_self,' ATTR=', FazAttr
69 print 1, ' F-Flag, Proc=',PM_Rank_self,' ATTR=',FazAttr
71 1 format( a, i5, a, i5 )
74 if (PM_Rank_self .eq. 0) then
78 print *, ' Found ', errs, ' errors'
81 call MPI_Comm_free( Faz_WORLD, Error )
82 call MPI_FINALIZE (PM_GLOBAL_ERROR)
86 C MPI 1.1 changed these from functions to subroutines.
88 SUBROUTINE FazCreate (comm, keyval, fuzzy,
89 & attr_in, attr_out, flag, ierr )
90 INTEGER comm, keyval, fuzzy, attr_in, attr_out
93 attr_out = attr_in + 1
98 SUBROUTINE FazDelete (comm, keyval, attr, extra, ierr )
99 INTEGER comm, keyval, attr, extra, ierr
102 if (keyval .ne. MPI_KEYVAL_INVALID)then