teshsuite/smpi/mpich3-test/f77/rma/wingroupf.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       program main
   7       implicit none
   8       include 'mpif.h'
   9       integer ierr, errs
  10       integer buf(10)
  11       integer comm, group1, group2, result, win, intsize
  12       logical mtestGetIntraComm
  13       include 'addsize.h'
  14
  15       errs = 0
  16       call mtest_init( ierr )
  17
  18       call mpi_type_size( MPI_INTEGER, intsize, ierr )
  19       do while( mtestGetIntraComm( comm, 2, .false. ) )
  20          asize = 10
  21          call mpi_win_create( buf, asize, intsize,
  22      &                        MPI_INFO_NULL, comm, win, ierr )
  23
  24          call mpi_comm_group( comm, group1, ierr )
  25          call mpi_win_get_group( win, group2, ierr )
  26          call mpi_group_compare( group1, group2, result, ierr )
  27          if (result .ne. MPI_IDENT) then
  28             errs = errs + 1
  29             print *, ' Did not get the ident groups'
  30          endif
  31          call mpi_group_free( group1, ierr )
  32          call mpi_group_free( group2, ierr )
  33
  34          call mpi_win_free( win, ierr )
  35          call mtestFreeComm( comm )
  36       enddo
  37 C
  38       call mtest_finalize( errs )
  39       call mpi_finalize( ierr )
  40
  41       end