teshsuite/smpi/mpich3-test/f90/coll/split_typef90.f90

   1 ! This file created from test/mpi/f77/coll/split_typef.f with f77tof90
   2 ! -*- Mode: Fortran; -*-
   3 !
   4 !  (C) 2011 by Argonne National Laboratory.
   5 !      See COPYRIGHT in top-level directory.
   6 !
   7       program main
   8       use mpi
   9       integer ierr, errs
  10       integer i, size, rank, comm, newcomm
  11       integer maxSize
  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