teshsuite/smpi/mpich3-test/f77/rma/c2f2cwinf.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C  (C) 2003 by Argonne National Laboratory.
   4 C      See COPYRIGHT in top-level directory.
   5 C
   6 C Test just MPI-RMA
   7 C
   8       program main
   9       implicit none
  10       include 'mpif.h'
  11       integer errs, toterrs, ierr
  12       integer wrank, wsize
  13       integer wgroup, info, req, win
  14       integer result
  15       integer c2fwin
  16 C The integer asize must be of ADDRESS_KIND size
  17       include 'addsize.h'
  18       errs = 0
  19
  20       call mpi_init( ierr )
  21
  22 C
  23 C Test passing a Fortran MPI object to C
  24       call mpi_comm_rank( MPI_COMM_WORLD, wrank, ierr )
  25       asize = 0
  26       call mpi_win_create( 0, asize, 1, MPI_INFO_NULL,
  27      $     MPI_COMM_WORLD, win, ierr )
  28       errs = errs + c2fwin( win )
  29       call mpi_win_free( win, ierr )
  30
  31 C
  32 C Test using a C routine to provide the Fortran handle
  33       call f2cwin( win )
  34 C     no info, in comm world, created with no memory (base address 0,
  35 C     displacement unit 1
  36       call mpi_win_free( win, ierr )
  37
  38 C
  39 C Summarize the errors
  40 C
  41       call mpi_allreduce( errs, toterrs, 1, MPI_INTEGER, MPI_SUM,
  42      $     MPI_COMM_WORLD, ierr )
  43       if (wrank .eq. 0) then
  44          if (toterrs .eq. 0) then
  45             print *, ' No Errors'
  46          else
  47             print *, ' Found ', toterrs, ' errors'
  48          endif
  49       endif
  50
  51       call mpi_finalize( ierr )
  52       end
  53