! This file created from test/mpi/f77/rma/aintf.f with f77tof90 ! -*- Mode: Fortran; -*- ! ! ! (C) 2014 by Argonne National Laboratory. ! See COPYRIGHT in top-level directory. ! ! This program tests MPI_Aint_add/diff in MPI-3.1. ! The two functions are often used in RMA code. ! See https://svn.mpi-forum.org/trac/mpi-forum-web/ticket/349 program main use mpi integer :: rank, nproc integer :: ierr, errs integer :: array(0:1023) integer :: val, target_rank; integer(kind=MPI_ADDRESS_KIND) :: bases(0:1), disp, offset integer(kind=MPI_ADDRESS_KIND) :: winsize integer :: win integer :: intsize errs = 0 call mtest_init(ierr); call MPI_Comm_rank(MPI_COMM_WORLD, rank, ierr) call MPI_Comm_size(MPI_COMM_WORLD, nproc, ierr) if (rank == 0 .and. nproc /= 2) then print *, 'Must run with 2 ranks' call MPI_Abort(MPI_COMM_WORLD, 1, ierr) endif ! Get the base address in the middle of the array if (rank == 0) then target_rank = 1 array(0) = 1234 call MPI_Get_address(array(512), bases(0), ierr) else if (rank == 1) then target_rank = 0 array(1023) = 1234 call MPI_Get_address(array(512), bases(1), ierr) endif ! Exchange bases call MPI_Type_size(MPI_INTEGER, intsize, ierr); call MPI_Allgather(MPI_IN_PLACE, 0, MPI_DATATYPE_NULL, bases, & & 1, MPI_AINT, MPI_COMM_WORLD, ierr) call MPI_Win_create_dynamic(MPI_INFO_NULL, & & MPI_COMM_WORLD, win, ierr) winsize = intsize*1024 call MPI_Win_attach(win, array, winsize, ierr) ! Do MPI_Aint addressing arithmetic if (rank == 0) then disp = intsize*511 offset = MPI_Aint_add(bases(1), disp) else if (rank == 1) then disp = intsize*512 offset = MPI_Aint_diff(bases(0), disp) endif ! Get value and verify it call MPI_Win_fence(MPI_MODE_NOPRECEDE, win, ierr) call MPI_Get(val, 1, MPI_INTEGER, target_rank, & & offset, 1, MPI_INTEGER, win, ierr) call MPI_Win_fence(MPI_MODE_NOSUCCEED, win, ierr) if (val /= 1234) then errs = errs + 1 print *, rank, ' -- Got', val, 'expected 1234' endif call MPI_Win_detach(win, array, ierr) call MPI_Win_free(win, ierr) call MTest_Finalize(errs) call MPI_Finalize(ierr); end