1 ! This file created from test/mpi/f77/rma/winattr2f.f with f77tof90
2 ! -*- Mode: Fortran; -*-
4 ! (C) 2003 by Argonne National Laboratory.
5 ! See COPYRIGHT in top-level directory.
6 ! This is a modified version of winattrf.f that uses two of the
12 integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val
14 integer comm, win, buf(10)
18 ! The only difference between the MPI-2 and MPI-1 attribute caching
19 ! routines in Fortran is that the take an address-sized integer
20 ! instead of a simple integer. These still are not pointers,
21 ! so the values are still just integers.
24 call mtest_init( ierr )
25 call mpi_comm_dup( MPI_COMM_WORLD, comm, ierr )
26 ! Create a new window; use val for an address-sized int
28 call mpi_win_create( buf, val, 1, &
29 & MPI_INFO_NULL, comm, win, ierr )
32 call mpi_win_create_keyval( MPI_WIN_DUP_FN, &
33 & MPI_WIN_NULL_DELETE_FN, keyval, &
36 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
39 print *, ' get attr returned true when no attr set'
43 call mpi_win_set_attr( win, keyval, valin, ierr )
46 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
47 if (valout .ne. 2003) then
49 print *, 'Unexpected value (should be 2003)', valout, &
54 call mpi_win_set_attr( win, keyval, valin, ierr )
57 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
58 if (valout .ne. 2001) then
60 print *, 'Unexpected value (should be 2001)', valout, &
64 ! Test the attr delete function
65 call mpi_win_delete_attr( win, keyval, ierr )
67 call mpi_win_get_attr( win, keyval, valout, flag, ierr )
70 print *, ' Delete_attr did not delete attribute'
73 ! Test the delete function on window free
75 call mpi_win_set_attr( win, keyval, valin, ierr )
76 call mpi_win_free( win, ierr )
77 call mpi_comm_free( comm, ierr )
79 call mpi_win_free_keyval( keyval, ierr )
80 if (ierr .ne. MPI_SUCCESS) then
82 call mtestprinterror( ierr )
85 call mtest_finalize( errs )
86 call mpi_finalize( ierr )