! 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