Search code examples
fortranmpimpi-io

How to create an mpi_type_indexed with an unordered array of displacements


I have some data to write in specific position in a file. Each position is given to me in an array. At the moment I write them by writing each variable at the specific position with mpi_file_write_at. Positions are neither contiguous nor they are ordered, so the program go back and forth into the file.

DO I=1,SIZE(VALUES)
  POS=ALL_POS(I)
  VAL=VALUES(I)
  CALL MPI_FILE_WRITE_AT(FH,POS,VAL,1,MPI_REAL,MPI_STATUS_IGNORE,IERR)
END DO

But I know the recommended way to have good performance is to use a file view and collective writing routines. So I think the solution would be to create an mpi_type_indexed with the array ALL_POS used as the array of displacements. And then use this type to describe the file with mpi_file_set_view. But when I do that, the program crash every time the array is not ordered.

Below is a minimal example which reproduce my problem. The program compile but segfault. If you change the value of DISPLACEMENTS(3) to something superior to DISPLACEMENTS(2), the program will run without any problems. (It also seems to work sometimes for some values inferior to DISPLACEMENTS(2), for instance 99)

So is it possible to create an indexed type with unordered array of displacements and use it as a view? I cannot find anything in the doc who says the contrary. The only restriction seems to be on the blocklenghts array, which must be only positive integer.

  PROGRAM INDEXED
    USE MPI
    IMPLICIT NONE
    REAL :: A(0:15)
    INTEGER :: INDEXTYPE,FH,IERR
    DATA A /1.0,  2.0,  3.0,  4.0,  5.0,  6.0,  7.0,  8.0,
 &          9.0, 10.0, 11.0, 12.0, 13.0, 14.0, 15.0, 16.0 /
    INTEGER(KIND=MPI_OFFSET_KIND) :: OFFSET

    CALL MPI_INIT(IERR)
    CALL CREATE_DATARES_TYPE(INDEXTYPE)

    CALL MPI_FILE_OPEN(MPI_COMM_WORLD, "TEST",
 &                     MPI_MODE_RDWR+MPI_MODE_CREATE,
 &                     MPI_INFO_NULL,FH,IERR)
    CALL MPI_CHECK_CALL(IERR)

    OFFSET=0
    CALL MPI_FILE_SET_VIEW(FH, OFFSET,MPI_REAL,
 &                         INDEXTYPE,'NATIVE',
 &                         MPI_INFO_NULL, IERR)
    CALL MPI_CHECK_CALL(IERR)

    CALL MPI_FILE_WRITE(FH,A,SIZE(A),MPI_REAL,
 &                      MPI_STATUS_IGNORE,IERR)
    CALL MPI_CHECK_CALL(IERR)

    CALL MPI_FILE_CLOSE(FH,IERR)
    CALL MPI_CHECK_CALL(IERR)

    CALL MPI_FINALIZE(IERR) 
  END PROGRAM INDEXED

  SUBROUTINE CREATE_DATARES_TYPE(DATARES_TYPE)
    USE MPI
    IMPLICIT NONE
    INTEGER, INTENT(OUT) :: DATARES_TYPE
    INTEGER :: IERR, N
    INTEGER, ALLOCATABLE :: BLOCKLENS(:), DISPLACEMENTS(:)
    N=3
    ALLOCATE(BLOCKLENS(N))
    ALLOCATE(DISPLACEMENTS(N))
    BLOCKLENS(1) = 1
    BLOCKLENS(2) = 3
    BLOCKLENS(1) = 1
    DISPLACEMENTS(1) = 2
    DISPLACEMENTS(2) = 100
    DISPLACEMENTS(3) = 51

    CALL MPI_TYPE_INDEXED(N, BLOCKLENS, DISPLACEMENTS,
 &                        MPI_REAL, DATARES_TYPE, IERR)
    CALL MPI_CHECK_CALL(IERR)

    CALL MPI_TYPE_COMMIT(DATARES_TYPE, IERR)
    CALL MPI_CHECK_CALL(IERR)

    DEALLOCATE(BLOCKLENS)
    DEALLOCATE(DISPLACEMENTS)
  END SUBROUTINE

  SUBROUTINE MPI_CHECK_CALL(IERR)
    USE MPI
    IMPLICIT NONE
    INTEGER, INTENT(IN) :: IERR
    INTEGER :: NERR, RESULTLEN
    CHARACTER(LEN=MPI_MAX_ERROR_STRING) :: SERR
    IF(IERR /= MPI_SUCCESS) THEN
      CALL MPI_ERROR_STRING(IERR,SERR,RESULTLEN,NERR)
      WRITE(*,*)SERR
      CALL BACKTRACE
    END IF
  END SUBROUTINE

Solution

  • There is an error in the derived datatype construction.

    It should be

    BLOCKLENS(1) = 1
    BLOCKLENS(2) = 3
    BLOCKLENS(3) = 1
    

    instead of

    BLOCKLENS(1) = 1
    BLOCKLENS(2) = 3
    BLOCKLENS(1) = 1
    

    Then the test works fine with both ompio and romio314 components.