Newsgroups: comp.parallel.mpi
From: gross@noether.UCSC.EDU (Mike Gross)
Subject: HELP!: Derived types and MPI_Allgather
Organization: University of California, Santa Cruz
Date: 22 May 1995 21:24:44 GMT
Message-ID: <3pqves$na0@darkstar.UCSC.EDU>

Hello netters,
   I have a large 3D distributed array that I need to extract a slice from.  The
routine has to work for two different sizes, so I have to allocate the 2D slice
array for the larger size, and work around the fact that it is incorrect (yes,
I know this should be coded in C so that I can use malloc(), but the code I'm
doing this with is nearly 10,000 lines of Fortran with lots of common arrays,
and I *really* don't want to translate it all).
   The right way to work around the incorrect dimensioning seems to be a
derived data type, but I have very little experience with them, and it looks
like I got it wrong.  I've been playing with the MPI_UB data type to adjust
the extent, and it is becoming quite clear to me that there is something I
don't understand about derived types.
   Could someone please have a look at the following routine and let me know
what I messed up?  Many, many thanks in advance.

Mike Gross
Physics Dept.
Univ. of California
Santa Cruz, CA 95064
(408) 459-4588
gross@physics.ucsc.edu


ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c     Routine gathers a slice of a distributed 3D array into a non-distributed
c     2D array visible on all processors.  It is presumed that the 2D array
c     is square and the 3D array has a different I dimension (but of course
c     the same J and K dimensions).  Nsize2 is a kludge because arr2d must
c     be allocated local to *this* file, which means its size must be assumed
c     in the calling procedure.  Nsize2 is used only for allocation and for
c     declaring the derived type.  N is the I-index for the desired 2D slice.
c
      subroutine getslice(arr3d, arr2d, N, Nsize1, Nsize2)
      implicit none

      include 'parallel.common'

      integer Nsize1, Nsize2
      complex arr3d (Nsize1/2+1, Nsize1, Nsize1/Nproc)  ! Distributed 3D array
      complex arr2d (Nsize2, Nsize2)        ! Whole 2D array
      integer N                             ! Value of I for slice

      integer i                             ! Local DO loop counter
      integer ibsize                        ! Size of xferred blocks
      integer array2d                       ! Type for 2D subarray
      integer xslice                        ! Type for slice in I of 3D
      integer itemp                         ! Temporary integer storage
      integer icmplxsz                      ! Size of complex number
      integer blocklen(2)                   ! Block sizes for MPI_Type_struct
      integer disp(2)                       ! Displacements for MPI_Type_struct
      integer type(2)                       ! Types for MPI_Type_struct
d     integer icall                         ! Call number (for debugging)
d     save icall

d     icall = icall + 1
d     if (myproc.eq.1)
d    1  write (*,*) 'getslice call #',icall
d     write (11,*) 'getslice call #',icall
c
c     Check parameters in debug mode.
c
d     if (Nsize2.lt.Nsize1) then
d       if (myproc.eq.1)
d    1    write (*,*) 'ERROR: Illegal parameters in getslice()'
d       write (11,*) 'ERROR: Illegal parameters in getslice()'
d       call nodeabort
d     end if
c
c     Find out how big a complex number is
c
      call MPI_Type_extent(MPI_COMPLEX,    ! Type for which we want the size
     1                     icmplxsz,       ! Returned size
     2                     rc)             ! Error code
c
c     Create a derived type to extract a single plane out of the 3D array.
c
      disp(1) = icmplxsz*(N-1)
      disp(2) = icmplxsz*(Nsize1/2+1)
      type(1) = MPI_COMPLEX
      type(2) = MPI_UB
      blocklen(1) = 1
      blocklen(2) = 1
      call MPI_Type_struct(2,              ! Size of passed arrays
     1                     blocklen,       ! Array giving subblock lengths
     2                     disp,           ! Array giving *byte* displacements
     3                     type,           ! Array giving types for each block
     4                     xslice,         ! New type
     5                     rc)             ! Error code

      call MPI_Type_commit(xslice, rc)
c
c     Arr2d is *NOT* contiguous unless Nsize1 = Nsize2.  Not true in all cases.
c
      call MPI_Type_vector(Nsize1/Nproc,   ! Number of blocks
     1                     Nsize1,         ! Length of a block
     2                     Nsize2,         ! Space between starts of blocks
     3                     MPI_COMPLEX,    ! Type of array elements
     4                     itemp,          ! New type being defined
     5                     rc)             ! Error code
c
c     Fix up the upper bound of the extent so that memory mapping into a
c     too-large allocated array is correct.  We have allocated Nsize2 x Nsize2
c     but we want to use only Nsize1 x Nsize1.  It may be that Nsize2 > Nsize1
c
      disp(1) = 0
      disp(2) = icmplxsz*Nsize2*(Nsize1/Nproc)
      type(1) = itemp
      type(2) = MPI_UB
      blocklen(1) = 1
      blocklen(2) = 1
      call MPI_Type_struct(2,              ! Size of passed arrays
     1                     blocklen,       ! Array of subblock lengths
     2                     disp,           ! Array of *BYTE* displacements
     3                     type,           ! Array of types for each block
     4                     array2d,        ! New type
     5                     rc)             ! Error code

      call MPI_Type_commit(array2d, rc)
c
c     Collect the entire slice from all processors.
c
      call MPI_Allgather(arr3d,            ! Array to send elements from
     1                   Nsize1**2/Nproc,  ! Number of elements to send
     2                   xslice,           ! Data type sent
     3                   arr2d,            ! Array to collect elements in
     4                   1,                ! #elements received for each task
     5                   array2d,          ! Data type received
     6                   MPI_COMM_WORLD,   ! Every task participates
     7                   rc)               ! Error code
c
c     Remove the definition of local types.
c
      call MPI_Type_free(array2d, rc)
c     call MPI_Type_free(xslice, rc)

      return
      end


