1 C -*- Mode: Fortran; -*-
3 C (C) 2003 by Argonne National Laboratory.
4 C See COPYRIGHT in top-level directory.
6 subroutine query_fn( extrastate, status, ierr )
9 integer status(MPI_STATUS_SIZE), ierr
10 include 'attr1aints.h'
12 C set a default status
13 status(MPI_SOURCE) = MPI_UNDEFINED
14 status(MPI_TAG) = MPI_UNDEFINED
15 call mpi_status_set_cancelled( status, .false., ierr)
16 call mpi_status_set_elements( status, MPI_BYTE, 0, ierr )
20 subroutine free_fn( extrastate, ierr )
24 include 'attr1aints.h'
26 common /fnccalls/ freefncall
28 C For testing purposes, the following print can be used to check whether
29 C the free_fn is called
30 C print *, 'Free_fn called'
32 extrastate = extrastate - 1
33 C The value returned by the free function is the error code
34 C returned by the wait/test function
38 subroutine cancel_fn( extrastate, complete, ierr )
43 include 'attr1aints.h'
49 C This is a very simple test of generalized requests. Normally, the
50 C MPI_Grequest_complete function would be called from another routine,
51 C often running in a separate thread. This simple code allows us to
52 C check that requests can be created, tested, and waited on in the
53 C case where the request is complete before the wait is called.
55 C Note that MPI did *not* define a routine that can be called within
56 C test or wait to advance the state of a generalized request.
57 C Most uses of generalized requests will need to use a separate thread.
64 integer status(MPI_STATUS_SIZE)
66 external query_fn, free_fn, cancel_fn
67 include 'attr1aints.h'
69 common /fnccalls/ freefncall
74 call MTest_Init( ierr )
77 call mpi_grequest_start( query_fn, free_fn, cancel_fn,
78 & extrastate, request, ierr )
79 call mpi_test( request, flag, status, ierr )
82 print *, 'Generalized request marked as complete'
85 call mpi_grequest_complete( request, ierr )
87 call MPI_Wait( request, status, ierr )
90 call mpi_grequest_start( query_fn, free_fn, cancel_fn,
91 & extrastate, request, ierr )
92 call mpi_grequest_complete( request, ierr )
93 call mpi_wait( request, MPI_STATUS_IGNORE, ierr )
95 C The following routine may prevent an optimizing compiler from
96 C just remembering that extrastate was set in grequest_start
97 call dummyupdate(extrastate)
98 if (extrastate .ne. 0) then
100 if (freefncall .eq. 0) then
101 print *, 'Free routine not called'
103 print *, 'Free routine did not update extra_data'
104 print *, 'extrastate = ', extrastate
108 call MTest_Finalize( errs )
109 call mpi_finalize( ierr )