Пример 6.1
Мы показываем, как реализовать общее присваивание A=B(map), где
у A, B и map распределены одинаковым образом,
и map является перестановочным вектором.
Для простоты, мы рассмотрим блочное распределение с блоками одинакового размера.
SUBROUTINE MAPVALS(A, B, map, m, comm, p)
USE MPI
INTEGER m, map(m), comm, p
REAL A(m), B(m)
INTEGER otype(p), oindex(m), & ! Используется для построения типов данных инициатора
ttype(p), tindex(m), & ! Используется для построения типов данных адресата
count(p), total(p), &
sizeofreal, win, ierr
! Эта часть делает работу, которая зависит от расположения B.
! Может многократно использоваться, пока расположение не изменяется
CALL MPI_TYPE_EXTENT(MPI_REAL, sizeofreal, ierr)
CALL MPI_WIN_CREATE(B, m*sizeofreal, sizeofreal, MPI_INFO_NULL, &
comm, win, ierr)
! Эта часть делает работу, которая зависит от значения MAP и
! расположения массивов.
! Может многократно использоваться, пока те не изменяются
! Вычисляет число записей, которые будут получены от каждого процесса
DO i=1,p
count(i) = 0
END DO
DO i=1,m
j = map(i)/m+1
count(j) = count(j)+1
END DO
total(1) = 0
DO i=2,p
total(i) = total(i-1) + count(i-1)
END DO
DO i=1,p
count(i) = 0
END DO
! Вычисляет origin и target индексы записей.
! Запись i в данном процессе получена из позиции
! k в процессе (j-1), где map(i) = (j-1)*m + (k-1),
! j = 1..p и k = 1..m
DO i=1,m
j = map(i)/m+1
k = MOD(map(i),m)+1
count(j) = count(j)+1
oindex(total(j) + count(j)) = i
tindex(total(j) + count(j)) = k
END DO
! Создает типы данных инициатора и адресата для каждой операции GET
DO i=1,p
CALL MPI_TYPE_INDEXED_BLOCK(count(i), 1, oindex(total(i)+1), &
MPI_REAL, otype(i), ierr)
CALL MPI_TYPE_COMMIT(otype(i), ierr)
CALL MPI_TYPE_INDEXED_BLOCK(count(i), 1, tindex(total(i)+1), &
MPI_REAL, ttype(i), ierr)
CALL MPI_TYPE_COMMIT(ttype(i), ierr)
END DO
! Эта часть непосредственно выполняет присваивание
CALL MPI_WIN_FENCE(0, win, ierr)
DO i=1,p
CALL MPI_GET(A, 1, otype(i), i-1, 0, 1, ttype(i), win, ierr)
END DO
CALL MPI_WIN_FENCE(0, win, ierr)
CALL MPI_WIN_FREE(win, ierr)
DO i=1,p
CALL MPI_TYPE_FREE(otype(i), ierr)
CALL MPI_TYPE_FREE(ttype(i), ierr)
END DO
RETURN
END
Пример 4.2
Можно написать более простую версию, которая не требует, чтобы для буфера
адресата создавался тип данных с использованием отдельного вызова
get для каждого элемента. Этот код гораздо проще, но обычно менее
эффективен для больших массивов.
SUBROUTINE MAPVALS(A, B, map, m, comm, p)
USE MPI
INTEGER m, map(m), comm, p
REAL A(m), B(m)
INTEGER sizeofreal, win, ierr
CALL MPI_TYPE_EXTENT(MPI_REAL, sizeofreal, ierr)
CALL MPI_WIN_CREATE(B, m*sizeofreal, sizeofreal, &
MPI_INFO_NULL, comm, win, ierr)
CALL MPI_WIN_FENCE(0, win, ierr)
DO i=1,m
j = map(i)/p
k = MOD(map(i),p)
CALL MPI_GET(A(i), 1, MPI_REAL, j, k, 1, MPI_REAL, &
win, ierr)
END DO
CALL MPI_WIN_FENCE(0, win, ierr)
CALL MPI_WIN_FREE(win, ierr)
RETURN
END