teshsuite/smpi/mpich-test/topol/cart2f.f

   1         program main
   2         include 'mpif.h'
   3
   4         integer NUM_DIMS
   5         parameter (NUM_DIMS=2)
   6
   7         integer rank, size, i
   8         integer dims(NUM_DIMS)
   9         logical periods(NUM_DIMS)
  10         integer new_coords(NUM_DIMS)
  11         integer new_new_coords(NUM_DIMS)
  12         logical reorder
  13
  14         integer comm_cart
  15         integer ierr
  16
  17         reorder= .true.
  18
  19         call MPI_INIT(ierr)
  20
  21         call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr)
  22         call MPI_COMM_SIZE(MPI_COMM_WORLD, size, ierr)
  23
  24 c     Clear dims array and get dims for topology
  25         do 100 i=1,NUM_DIMS
  26                 dims(i)=0
  27                 periods(i)=.false.
  28 100     continue
  29         call MPI_DIMS_CREATE(size, NUM_DIMS, dims, ierr)
  30
  31 c     Make a new communicator with a topology
  32         call MPI_CART_CREATE(MPI_COMM_WORLD, 2, dims, periods,
  33      $          reorder, comm_cart, ierr)
  34
  35 c     Does the mapping from rank to coords work
  36         call MPI_CART_COORDS(comm_cart, rank, NUM_DIMS, new_coords,
  37      $          ierr)
  38
  39 c     2nd call to Cart coords gives us an error - why?    *34*
  40         call MPI_CART_COORDS(comm_cart, rank, NUM_DIMS, new_new_coords,
  41      $          ierr)
  42
  43         call MPI_COMM_FREE(comm_cart, ierr)
  44 c       call Test_Waitforall()
  45         if (rank .eq. 0) then
  46 c          call MPI_ALLREDUCE( errors, toterrors, 1, MPI_INTEGER,
  47 c       1       MPI_SUM, MPI_COMM_WORLD )
  48            print *, ' No Errors'
  49 c          print *, ' Done with ', toterrors, ' ERRORS!'
  50         endif
  51         call MPI_FINALIZE(ierr)
  52 c        print *, 'cart2f completed, errors=', ierr
  53
  54         end