ОК, поэтому ошибка здесь связана с вызовом подпрограмм в стиле Fortran 90. Посмотрите эту ссылку для частичного объяснения (http://www.cs.rpi.edu/~szymansk/OOF90/bugs.html#8) Теперь в приведенном выше примере я бы просто поместил подпрограмму в конец программы. Это имеет эффект действия неявного оператора интерфейса (по крайней мере, в Компиляторы GFORTRAN и INTEL). Таким образом, мой псевдокод работал нормально, однако в моем производственном коде подпрограмма добавлена как часть библиотеки общего пользования, которую называли многие другие части кода. Если я связал свой псевдокод с этой библиотекой, которая была скопируйте и вставьте подпрограмму в псевдокод, код будет аварийно завершать работу, как в рабочем коде. Однако, если я добавлю блок INTERFACE, все будет работать нормально.
Так, где это оставляет меня? Что ж, по «причинам» я не хотел писать еще один специализированный модуль, но мне кажется, что мне все равно придется вложить в него все различные подпрограммы общей памяти. Другой вариант - добавить блоки интерфейса к каждому биту разделяемой памяти, выделяя субкод (бла).
Вот фиксированный код, но вам нужно отдельно скомпилировать подпрограмму и программу и создать ссылку, чтобы увидеть эффект наличия / отсутствия блока INTERFACE.
Основная программа:
PROGRAM TEST_SUBROUTINE
! Libraries
USE MPI
IMPLICIT NONE
INTERFACE
SUBROUTINE mpialloc_1d_dbl(array,n1,subid,mymaster,share_comm,win)
DOUBLE PRECISION, POINTER, INTENT(inout) :: array(:)
INTEGER, INTENT(in) :: n1
INTEGER, INTENT(in) :: subid
INTEGER, INTENT(in) :: mymaster
INTEGER, INTENT(inout) :: share_comm
INTEGER, INTENT(inout) :: win
END SUBROUTINE mpialloc_1d_dbl
END INTERFACE
! Variables
INTEGER :: ier, myid, numprocs
INTEGER :: myid_shar, numprocs_shar
INTEGER :: MPI_COMM_SHARMEM, win_a
DOUBLE PRECISION, POINTER :: A(:)
! Code
CALL MPI_INIT(ier)
CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, ier )
CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ier)
myid_shar=0
CALL MPI_COMM_SPLIT_TYPE(MPI_COMM_WORLD, MPI_COMM_TYPE_SHARED, 0, MPI_INFO_NULL, MPI_COMM_SHARMEM, ier)
CALL MPI_COMM_RANK( MPI_COMM_SHARMEM, myid_shar, ier )
CALL MPI_COMM_SIZE( MPI_COMM_SHARMEM, numprocs_shar, ier)
CALL mpialloc_1d_dbl(A,numprocs_shar,myid_shar,0,MPI_COMM_SHARMEM,win_a)
A(myid_shar+1) = myid_shar
CALL MPI_WIN_FENCE(0, win_a, ier)
IF (myid == 0) THEN
PRINT *,A(1)
PRINT *,A(2)
PRINT *,A(3)
PRINT *,A(4)
END IF
! FREE Window
CALL MPI_WIN_FENCE(0, win_a, ier)
CALL MPI_BARRIER(MPI_COMM_SHARMEM, ier)
CALL MPI_WIN_FREE(win_a,ier)
! FREE MPI_COMM_SHARMEM
CALL MPI_BARRIER(MPI_COMM_SHARMEM, ier)
CALL MPI_COMM_FREE(MPI_COMM_SHARMEM,ier)
! END MPI
CALL MPI_BARRIER(MPI_COMM_WORLD, ier)
CALL MPI_FINALIZE(ier)
END PROGRAM TEST_SUBROUTINE
Подпрограмма:
SUBROUTINE mpialloc_1d_dbl(array,n1,subid,mymaster,share_comm,win)
! Libraries
USE MPI
USE ISO_C_BINDING
IMPLICIT NONE
! Arguments
DOUBLE PRECISION, POINTER, INTENT(inout) :: array(:)
INTEGER, INTENT(in) :: n1
INTEGER, INTENT(in) :: subid
INTEGER, INTENT(in) :: mymaster
INTEGER, INTENT(inout) :: share_comm
INTEGER, INTENT(inout) :: win
! Variables
INTEGER :: disp_unit, ier
INTEGER :: array_shape(1)
INTEGER(KIND=MPI_ADDRESS_KIND) :: window_size
TYPE(C_PTR) :: baseptr
ier = 0
array_shape(1) = n1
disp_unit = 8_MPI_ADDRESS_KIND
window_size = 0_MPI_ADDRESS_KIND
IF (subid == mymaster) window_size = INT(n1,MPI_ADDRESS_KIND)
CALL MPI_BARRIER(share_comm, ier)
CALL MPI_WIN_ALLOCATE_SHARED(window_size, disp_unit, MPI_INFO_NULL, share_comm, baseptr, win ,ier)
IF (subid /= mymaster) CALL MPI_WIN_SHARED_QUERY(win, 0, window_size, disp_unit, baseptr, ier)
CALL C_F_POINTER(baseptr, array, array_shape)
CALL MPI_WIN_FENCE(0, win, ier)
RETURN
END SUBROUTINE mpialloc_1d_dbl