C -*- Mode: Fortran; -*- 
C
C  (C) 2004 by Argonne National Laboratory.
C      See COPYRIGHT in top-level directory.
C
C Test various combinations of periodic and non-periodic Cartesian 
C communicators
C
      program main
      implicit none
      include 'mpif.h'
      integer errs, ierr
      integer ndims, nperiods, i, size
      integer comm, source, dest, newcomm
      integer maxdims
      parameter (maxdims=7)
      logical periods(maxdims), outperiods(maxdims)
      integer dims(maxdims), outdims(maxdims)
      integer outcoords(maxdims)

      errs = 0
      call mtest_init( ierr )

C
C     For up to 6 dimensions, test with periodicity in 0 through all
C     dimensions.  The test is computed by both:
C         get info about the created communicator
C         apply cart shift
C     Note that a dimension can have size one, so that these tests
C     can work with small numbers (even 1) of processes
C
      comm = MPI_COMM_WORLD
      call mpi_comm_size( comm, size, ierr )
      do ndims = 1, 6
         do nperiods = 0, ndims
            do i=1,ndims
               periods(i) = .false.
               dims(i)    = 0
            enddo
            do i=1,nperiods
               periods(i) = .true.
            enddo

            call mpi_dims_create( size, ndims, dims, ierr )
            call mpi_cart_create( comm, ndims, dims, periods, .false.,
     $           newcomm, ierr )

            if (newcomm .ne. MPI_COMM_NULL) then
               call mpi_cart_get( newcomm, maxdims, outdims, outperiods,
     $              outcoords, ierr )
C               print *, 'Coords = '
               do i=1, ndims
C                  print *, i, '(', outcoords(i), ')'
                  if (periods(i) .neqv. outperiods(i)) then
                     errs = errs + 1
                     print *, ' Wrong value for periods ', i
                     print *, ' ndims = ', ndims
                  endif
               enddo

               do i=1, ndims
                  call mpi_cart_shift( newcomm, i-1, 1, source, dest,
     $                 ierr )
                  if (outcoords(i) .eq. outdims(i)-1) then
                     if (periods(i)) then
                        if (dest .eq. MPI_PROC_NULL) then
                           errs = errs + 1
                           print *, 'Expected rank, got proc_null'
                        endif
                     else
                        if (dest .ne. MPI_PROC_NULL) then
                           errs = errs + 1
                           print *, 'Expected procnull, got ', dest
                        endif
                     endif
                  endif
                  
                  call mpi_cart_shift( newcomm, i-1, -1, source, dest,
     $                 ierr )
                  if (outcoords(i) .eq. 0) then
                     if (periods(i)) then
                        if (dest .eq. MPI_PROC_NULL) then
                           errs = errs + 1
                           print *, 'Expected rank, got proc_null'
                        endif
                     else
                        if (dest .ne. MPI_PROC_NULL) then
                           errs = errs + 1
                           print *, 'Expected procnull, got ', dest
                        endif
                     endif
                  endif
               enddo
               call mpi_comm_free( newcomm, ierr )
            endif
            
         enddo
      enddo
      
      call mtest_finalize( errs )
      call mpi_finalize( ierr )
      end