Created
December 8, 2017 22:31
-
-
Save AboorvaDevarajan/dfa64f77ffcd3a9907ebee727d5a49b1 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
! This file created from test/mpi/f77/pt2pt/greqf.f with f77tof90 | |
! -*- Mode: Fortran; -*- | |
! | |
! (C) 2003 by Argonne National Laboratory. | |
! See COPYRIGHT in top-level directory. | |
! | |
subroutine query_fn( extrastate, status, ierr ) | |
use mpi | |
integer status(MPI_STATUS_SIZE), ierr | |
integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val | |
! | |
! set a default status | |
status(MPI_SOURCE) = MPI_UNDEFINED | |
status(MPI_TAG) = MPI_UNDEFINED | |
call mpi_status_set_cancelled( status, .false., ierr) | |
call mpi_status_set_elements( status, MPI_BYTE, 0, ierr ) | |
ierr = MPI_SUCCESS | |
end | |
! | |
subroutine free_fn( extrastate, ierr ) | |
use mpi | |
integer value, ierr | |
integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val | |
integer freefncall | |
common /fnccalls/ freefncall | |
! | |
! For testing purposes, the following print can be used to check whether | |
! the free_fn is called | |
! print *, 'Free_fn called' | |
! | |
extrastate = extrastate - 1 | |
! The value returned by the free function is the error code | |
! returned by the wait/test function | |
ierr = MPI_SUCCESS | |
end | |
! | |
subroutine cancel_fn( extrastate, complete, ierr ) | |
use mpi | |
integer ierr | |
logical complete | |
integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val | |
ierr = MPI_SUCCESS | |
end | |
! | |
! | |
! This is a very simple test of generalized requests. Normally, the | |
! MPI_Grequest_complete function would be called from another routine, | |
! often running in a separate thread. This simple code allows us to | |
! check that requests can be created, tested, and waited on in the | |
! case where the request is complete before the wait is called. | |
! | |
! Note that MPI did *not* define a routine that can be called within | |
! test or wait to advance the state of a generalized request. | |
! Most uses of generalized requests will need to use a separate thread. | |
! | |
program main | |
use mpi | |
integer errs, ierr | |
logical flag | |
integer status(MPI_STATUS_SIZE) | |
integer request | |
external query_fn, free_fn, cancel_fn | |
integer (kind=MPI_ADDRESS_KIND) extrastate, valin, valout, val | |
integer freefncall | |
common /fnccalls/ freefncall | |
errs = 0 | |
freefncall = 0 | |
call MPI_Init( ierr ) | |
extrastate = 0 | |
call mpi_grequest_start( query_fn, free_fn, cancel_fn, & | |
& extrastate, request, ierr ) | |
call mpi_test( request, flag, status, ierr ) | |
if (flag) then | |
errs = errs + 1 | |
print *, 'Generalized request marked as complete' | |
endif | |
call mpi_grequest_complete( request, ierr ) | |
call MPI_Wait( request, status, ierr ) | |
extrastate = 1 | |
call mpi_grequest_start( query_fn, free_fn, cancel_fn, & | |
& extrastate, request, ierr ) | |
call mpi_grequest_complete( request, ierr ) | |
call mpi_wait( request, MPI_STATUS_IGNORE, ierr ) | |
call mpi_finalize( ierr ) | |
end |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment