teshsuite/smpi/mpich3-test/f77/coll/split_typef.f

   1 C -*- Mode: Fortran; -*-
   2 C
   3 C  (C) 2011 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 i, ans, size, rank, color, comm, newcomm
  11       integer maxSize, displ
  12       parameter (maxSize=128)
  13       integer scounts(maxSize), sdispls(maxSize), stypes(maxSize)
  14       integer rcounts(maxSize), rdispls(maxSize), rtypes(maxSize)
  15       integer sbuf(maxSize), rbuf(maxSize)
  16
  17       errs = 0
  18
  19       call mtest_init( ierr )
  20
  21       call mpi_comm_dup( MPI_COMM_WORLD, comm, ierr )
  22
  23       call mpi_comm_split_type( comm, MPI_COMM_TYPE_SHARED, rank,
  24      &     MPI_INFO_NULL, newcomm, ierr )
  25       call mpi_comm_rank( newcomm, rank, ierr )
  26       call mpi_comm_size( newcomm, size, ierr )
  27
  28       do i=1, size
  29          scounts(i) = 1
  30          sdispls(i) = (i-1)
  31          stypes(i)  = MPI_INTEGER
  32          sbuf(i) = rank * size + i
  33          rcounts(i) = 1
  34          rdispls(i) = (i-1)
  35          rtypes(i)  = MPI_INTEGER
  36          rbuf(i) = -1
  37       enddo
  38       call mpi_alltoallv( sbuf, scounts, sdispls, stypes,
  39      &     rbuf, rcounts, rdispls, rtypes, newcomm, ierr )
  40
  41       call mpi_comm_free( newcomm, ierr )
  42       call mpi_comm_free( comm, ierr )
  43
  44       call mtest_finalize( errs )
  45       call mpi_finalize( ierr )
  46       end