Subarray type creation broken for 3D arrays

[keithbennett]

As of version 1.10.1, the creation of 3d subarrays no longer works. It was working without issue in 1.10.0. The following fortran code illustrates the problem. It should be run using 4 processes.

PROGRAM test_subarray

  USE mpi
  IMPLICIT NONE

  INTEGER :: ierror, rank, nproc, fileview, filehandle, j, k
  INTEGER, PARAMETER :: ndims = 3, nn = 2
  INTEGER, PARAMETER :: nblocks(ndims) = (/1, 2, 2/)
  INTEGER, DIMENSION(ndims) :: sizes, subsizes, starts
  INTEGER, DIMENSION(nn,nn,nn) :: array
  INTEGER, DIMENSION(nn,2*nn,2*nn) :: big_array_expected, big_array
  INTEGER(KIND=MPI_OFFSET_KIND) :: disp

  CALL MPI_INIT(ierror)
  CALL MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierror)
  CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nproc, ierror)

  IF (nproc /= 4 .AND. rank == 0) THEN
    PRINT*, 'ERROR: This test case must be run with 4 processes'
    CALL MPI_ABORT(MPI_COMM_WORLD, -1, ierror)
  ENDIF

  array = rank

  sizes = nblocks * nn
  subsizes = nn
  starts(1) = 0
  starts(2) = MOD(rank, 2) * nn
  starts(3) = (rank / 2) * nn

  CALL MPI_TYPE_CREATE_SUBARRAY(ndims, sizes, subsizes, starts, &
      MPI_ORDER_FORTRAN, MPI_INTEGER, fileview, ierror)
  CALL MPI_TYPE_COMMIT(fileview, ierror)

  CALL MPI_FILE_OPEN(MPI_COMM_WORLD, 'test.dat', &
      MPI_MODE_CREATE + MPI_MODE_RDWR, MPI_INFO_NULL, filehandle, ierror)

  disp = 0
  CALL MPI_FILE_SET_VIEW(filehandle, disp, MPI_INTEGER, fileview, 'native', &
      MPI_INFO_NULL, ierror)
  CALL MPI_FILE_WRITE_ALL(filehandle, array, SIZE(array), MPI_INTEGER, &
      MPI_STATUS_IGNORE, ierror)

  CALL MPI_FILE_SET_VIEW(filehandle, disp, MPI_BYTE, MPI_BYTE, 'native', &
      MPI_INFO_NULL, ierror)

  IF (rank == 0) THEN
    big_array_expected(:,1:nn,1:nn) = 0
    big_array_expected(:,nn+1:2*nn,1:nn) = 1
    big_array_expected(:,1:nn,nn+1:2*nn) = 2
    big_array_expected(:,nn+1:2*nn,nn+1:2*nn) = 3

    big_array = -1

    CALL MPI_FILE_READ(filehandle, big_array, SIZE(big_array), &
        MPI_INTEGER, MPI_STATUS_IGNORE, ierror)

    PRINT*, 'The test has failed if any value is non-zero'
    DO k = 1, SIZE(big_array,3)
      PRINT'(99i4)', big_array(:,:,k) - big_array_expected(:,:,k)
    ENDDO
    IF (ALL(big_array == big_array_expected)) THEN
      PRINT*, 'SUCCESS!'
    ELSE
      PRINT*, 'FAILED!'
    ENDIF
  ENDIF

  CALL MPI_FILE_CLOSE(filehandle, ierror)
  CALL MPI_FINALIZE(ierror)

END PROGRAM test_subarray

[hppritcha]

@keithbennett just in case its important. which fortran compiler are you using?

[hppritcha]

this test fails with master as well using gfortran 4.9.2. The test passes with craypich/mpich.

[keithbennett]

I've tried using both gfortran-5.2.1 and Intel's ifort-13.1.1. Both give the same results.

[ggouaillardet]

there is an issue with MPI_Type_create_subarray and a fix is being investigated at #1196

but in this case, that does not explain all ...
i rewrote the program and manually created the subarray with MPI_Type_create_struct but i got the same behaviour (e.g. works fine with mpich, fails with ompi)

here is my revamped version, the STRUCT macro can be 0 or 1

#define DEBUG 0
#define STRUCT 0
PROGRAM test_subarray

  USE mpi
  IMPLICIT NONE

  INTEGER :: ierror, rank, nproc, fileview, filehandle, j, k
  INTEGER, PARAMETER :: ndims = 3, nn = 2
  INTEGER, PARAMETER :: nblocks(ndims) = (/1, 2, 2/)
  INTEGER, DIMENSION(ndims) :: sizes, subsizes, starts
  INTEGER, DIMENSION(nn,nn,nn) :: array
  INTEGER, DIMENSION(nn,2*nn,2*nn) :: big_array_expected, big_array
  INTEGER(KIND=MPI_OFFSET_KIND) :: disp
  INTEGER(KIND=MPI_OFFSET_KIND) :: lb, tlb, ext, text
  INTEGER t1, t2, t3
  INTEGER, DIMENSION(128) :: a1, a2, a3, zero
  INTEGER sze
  INTEGER, DIMENSION(2) :: abl, at
  INTEGER(KIND=MPI_OFFSET_KIND), DIMENSION(2) :: ad


  CALL MPI_INIT(ierror)
  CALL MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierror)
  CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nproc, ierror)

  IF (nproc /= 4 .AND. rank == 0) THEN
    PRINT*, 'ERROR: This test case must be run with 4 processes'
    CALL MPI_ABORT(MPI_COMM_WORLD, -1, ierror)
  ENDIF

  array = rank

  sizes = nblocks * nn
  subsizes = nn
  starts(1) = 0
  starts(2) = MOD(rank, 2) * nn
  starts(3) = (rank / 2) * nn
  do j=1,128
    a1(j) = -1
    a2(j) = -1
    a3(j) = -1
    zero(j) = j
  end do

  CALL MPI_TYPE_CREATE_SUBARRAY(1, sizes, subsizes, starts, &
      MPI_ORDER_FORTRAN, MPI_INTEGER, t1, ierror)
  CALL MPI_TYPE_COMMIT(t1, ierror)
  CALL MPI_TYPE_GET_EXTENT(t1,lb,ext,ierror)
  CALL MPI_TYPE_GET_TRUE_EXTENT(t1,tlb,text,ierror)
  CALL MPI_TYPE_SIZE(t1,sze,ierror)
  sze = sze / 4
#if DEBUG
  print *, 'LB = ', lb, ', ', tlb
  print *, 'EXTENT = ', ext, ', ', text
  print *, 'SIZE = ', sze
#endif
  CALL MPI_SENDRECV(zero, sze, MPI_INT, 0, 0, a1, 1, t1, 0, 0, MPI_COMM_SELF, &
      MPI_STATUS_IGNORE, ierror)
  CALL MPI_TYPE_CREATE_SUBARRAY(1, sizes(2:2), subsizes(2:2), starts(2:2), &
      MPI_ORDER_FORTRAN, t1, t2, ierror)
  CALL MPI_TYPE_FREE(t1, ierror)
  CALL MPI_TYPE_COMMIT(t2, ierror)
  CALL MPI_TYPE_GET_EXTENT(t2,lb,ext,ierror)
  CALL MPI_TYPE_GET_TRUE_EXTENT(t2,tlb,text,ierror)
  CALL MPI_TYPE_SIZE(t2,sze,ierror)
  sze = sze / 4
#if DEBUG
  print *, 'LB = ', lb, ', ', tlb
  print *, 'EXTENT = ', ext, ', ', text
  print *, 'SIZE = ', sze
#endif
  CALL MPI_SENDRECV(zero, sze, MPI_INT, 0, 0, a2, 1, t2, 0, 0, MPI_COMM_SELF, &
      MPI_STATUS_IGNORE, ierror)
  CALL MPI_TYPE_CREATE_SUBARRAY(1, sizes(3:3), subsizes(3:3), starts(3:3), &
      MPI_ORDER_FORTRAN, t2, fileview, ierror)
  CALL MPI_TYPE_COMMIT(fileview, ierror)
  CALL MPI_TYPE_FREE(t2, ierror)
  CALL MPI_TYPE_GET_EXTENT(fileview,lb,ext,ierror)
  CALL MPI_TYPE_GET_TRUE_EXTENT(fileview,tlb,text,ierror)
  CALL MPI_TYPE_SIZE(fileview,sze,ierror)
  sze = sze / 4
#if DEBUG
  print *, 'LB = ', lb, ', ', tlb
  print *, 'EXTENT = ', ext, ', ', text
  print *, 'SIZE = ', sze
#endif
  CALL MPI_SENDRECV(zero, sze, MPI_INT, 0, 0, a3, 1, fileview, 0, 0, MPI_COMM_SELF, &
      MPI_STATUS_IGNORE, ierror)

#if STRUCT
  CALL MPI_TYPE_FREE(fileview, ierror)
  abl(1) = 4
  abl(2) = 4
  at(1) = MPI_INT
  at(2) = MPI_INT
  if (rank == 0) then
    ad(1) = 0
    ad(2) = 32
  elseif (rank == 1) then
    ad(1) = 16
    ad(2) = 48
  elseif (rank == 2) then
    ad(1) = 64
    ad(2) = 96
  else
    ad(1) = 80
    ad(2) = 112
  endif
  CALL MPI_TYPE_CREATE_STRUCT(2, abl, ad, at, t3, ierror)
  CALL MPI_TYPE_COMMIT(t3, ierror)
  LB = 0
  EXT = 128
  CALL MPI_TYPE_CREATE_RESIZED(t3, LB, EXT, fileview, ierror)
  CALL MPI_TYPE_FREE(t3, ierror)
  CALL MPI_TYPE_COMMIT(fileview, ierror)
  CALL MPI_TYPE_GET_EXTENT(fileview,lb,ext,ierror)
  CALL MPI_TYPE_GET_TRUE_EXTENT(fileview,tlb,text,ierror)
  CALL MPI_TYPE_SIZE(fileview,sze,ierror)
  sze = sze / 4
#if DEBUG
  print *, 'LB = ', lb, ', ', tlb
  print *, 'EXTENT = ', ext, ', ', text
  print *, 'SIZE = ', sze
#endif
#endif

#if DEBUG
  do j=1,128
    if (a1(j).ne.-1) print *, 'A1(',j,') = ', a1(j)
  enddo
  do j=1,128
    if (a2(j).ne.-1) print *, 'A2(',j,') = ', a2(j)
  enddo
  do j=1,128
    if (a3(j).ne.-1) print *, 'A3(',j,') = ', a3(j)
  enddo
#endif


  CALL MPI_FILE_OPEN(MPI_COMM_WORLD, 'test.dat', &
      MPI_MODE_CREATE + MPI_MODE_RDWR, MPI_INFO_NULL, filehandle, &
ierror)

  disp = 0
  CALL MPI_FILE_SET_VIEW(filehandle, disp, MPI_INTEGER, fileview, &
      'native', &
      MPI_INFO_NULL, ierror)
  CALL MPI_FILE_WRITE_ALL(filehandle, array, SIZE(array), MPI_INTEGER, &
      MPI_STATUS_IGNORE, ierror)

  CALL MPI_FILE_SET_VIEW(filehandle, disp, MPI_BYTE, MPI_BYTE, 'native', &
      MPI_INFO_NULL, ierror)

  IF (rank == 0) THEN
    big_array_expected(:,1:nn,1:nn) = 0
    big_array_expected(:,nn+1:2*nn,1:nn) = 1
    big_array_expected(:,1:nn,nn+1:2*nn) = 2
    big_array_expected(:,nn+1:2*nn,nn+1:2*nn) = 3

    big_array = -1

    CALL MPI_FILE_READ(filehandle, big_array, SIZE(big_array), &
        MPI_INTEGER, MPI_STATUS_IGNORE, ierror)

    PRINT*, 'The test has failed if any value is non-zero'
    DO k = 1, SIZE(big_array,3)
      PRINT'(99i4)', big_array(:,:,k) - big_array_expected(:,:,k)
    ENDDO
    IF (ALL(big_array == big_array_expected)) THEN
      PRINT*, 'SUCCESS!'
    ELSE
      PRINT*, 'FAILED!'
    ENDIF
  ENDIF

  CALL MPI_FILE_CLOSE(filehandle, ierror)
  CALL MPI_FINALIZE(ierror)

END PROGRAM test_subarray

with master, the program fails with #1196 patch and ompio but works fine with romio

bottom line, there is an issue with MPI_Type_create_subarray _and_ ompio
(note if you are using v1.10 series, the default is romio so you are likely unaffected by the ompio bug)

[jsquyres]

@bosilca Can you have a look? This smells like a DDT issue...

[bosilca]

With the fix proposed for #1196 applied, this issue transforms from a [possible] datatype issue, into a test issue. Based on my understanding of MPI file, one should rewind the file between a write and a subsequent read, even when you change the view. If I force the position in the file to zero before the read, both versions of the test succeed. I also confirmed the correctness of the content of the file by doing a hexdump.

Btw, while investigating this issue I got some complaints from my fortran compiler (GNU Fortran 5.2.0) about missing prototypes for MPI_FILE_READ_AT and MPI_FILE_SEEK.

[ggouaillardet]

romio works fine with the patch, but ompio fails
if ompio closes the file and open again before reading, result is ok
as pointed by @bosilca , that issue could be in the test, and we are lucky romio is working.

[bosilca]

I stand corrected. I went back and read the section about MPI_FILE_SET_VIEW in the MPI 3.1 and it is clearly stated page 504 line 16 that

In addition, MPI_FILE_SET_VIEW resets the individual file pointers and the shared file pointer to zero.

So, the test is correct from the MPI perspective (sorry). At this point I would assume OMPIIO missed to reset the file pointer in MPI_FILE_SET_VIEW. @edgargabriel might clarify this.

[edgargabriel]

I'll have a look, We reset the entire fview structure, which should move the filepointer back to 0, but I'll check, maybe we missed something.

[edgargabriel]

Found the culprit, we forgot to reset two variables in the fview management to zero correctly. Will commit a fix shortly.

[edgargabriel]

@ggouaillardet I created a pull request towards your commit on the create_subarray branch, that fixed the problem for me, please let me know whether it works for you.