1 C -*- Mode: Fortran; -*-
3 C (C) 2003 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
5 C This is a modified version of winattrf.f that uses two of the
13 integer comm, win, buf(10)
17 C The only difference between the MPI-2 and MPI-1 attribute caching
18 C routines in Fortran is that the take an address-sized integer
19 C instead of a simple integer. These still are not pointers,
20 C so the values are still just integers.
23 call mtest_init( ierr )
24 call mpi_comm_dup( MPI_COMM_WORLD, comm, ierr )
25 C Create a new window; use val for an address-sized int
27 call mpi_win_create( buf, val, 1,
28 & MPI_INFO_NULL, comm, win, ierr )
31 call mpi_win_create_keyval( MPI_WIN_DUP_FN,
32 & MPI_WIN_NULL_DELETE_FN, keyval,
35 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
38 print *, ' get attr returned true when no attr set'
42 call mpi_win_set_attr( win, keyval, valin, ierr )
45 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
46 if (valout .ne. 2003) then
48 print *, 'Unexpected value (should be 2003)', valout,
53 call mpi_win_set_attr( win, keyval, valin, ierr )
56 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
57 if (valout .ne. 2001) then
59 print *, 'Unexpected value (should be 2001)', valout,
63 C Test the attr delete function
64 call mpi_win_delete_attr( win, keyval, ierr )
66 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
69 print *, ' Delete_attr did not delete attribute'
72 C Test the delete function on window free
74 call mpi_win_set_attr( win, keyval, valin, ierr )
75 call mpi_win_free( win, ierr )
76 call mpi_comm_free( comm, ierr )
78 call mpi_win_free_keyval( keyval, ierr )
79 if (ierr .ne. MPI_SUCCESS) then
81 call mtestprinterror( ierr )
84 call mtest_finalize( errs )
85 call mpi_finalize( ierr )