teshsuite/smpi/mpich3-test/f90/rma/c2f2cwinf90.f90

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