Как создать mpi_type_indexed с неупорядоченным массивом смещений

У меня есть некоторые данные для записи в определенной позиции в файле. Каждая позиция дается мне в массиве. На данный момент я пишу их, записывая каждую переменную в определенную позицию с помощью mpi_file_write_at. Позиции не являются ни смежными, ни упорядоченными, поэтому программа перемещается назад и вперед в файл.

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

Но я знаю, что рекомендуемый способ добиться хорошей производительности - использовать просмотр файлов и процедуры коллективной записи. Поэтому я думаю, что решение было бы создать mpi_type_indexed с массивом ALL_POS, используемым в качестве массива смещений. А затем используйте этот тип для описания файла с mpi_file_set_view. Но когда я это делаю, программа вылетает каждый раз, когда массив не упорядочен.

Ниже приведен минимальный пример, который воспроизводит мою проблему. Программа компилируется но segfault. Если вы измените значение DISPLACEMENTS(3) на значение, превосходящее DISPLACEMENTS(2), программа запустится без проблем. (Иногда кажется, что он работает для некоторых значений, которые ниже DISPLACEMENTS(2), например 99)

Так возможно ли создать индексированный тип с неупорядоченным массивом смещений и использовать его как представление? Я не могу найти ничего в документе, который говорит обратное. Похоже, что единственным ограничением является массив blocklenghts, который должен быть только положительным целым числом.

  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

1 ответ

Решение

Произошла ошибка в конструкции производного типа данных.

Так должно быть

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

вместо

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

Тогда тест отлично работает с обоими ompio а также romio314 компоненты.

Другие вопросы по тегам