Стр. 98 - Параллельное программирование

ПАРАЛЛЕЛЬНОЕ ПРОГРАММИРОВАНИЕ
96
Parameter(Nm=100)
Double Precision A(Nm,Nm), B(Nm,Nm),
$ Ac(Nm,Nm), Bc(Nm,Nm), C(Nm,Nm), Cc(Nm,Nm)
Integer Counts(0:Nm), Shifts(0:Nm),
$ Counts2(0:Nm), Shifts2(0:Nm)
Call MPI_INIT(Ierr)
Call MPI_COMM_SIZE(MPI_COMM_WORLD, Size, Ierr)
Call MPI_COMM_RANK(MPI_COMM_WORLD, Rank, Ierr)
C Задаются начальные значения матриц А и В
If (Rank.eq.0) Then
Do I = 1,Nm
Do J = 1,Nm
A(I,J) = I*J
B(I,J) = 1/A(I,J)
End Do
End Do
End If
C Каждый процесC определяет первый и последний
C столбец своих расчетов
BCol = Rank*Nm/Size+1
ECol = (Rank+1)*Nm/Size
C Каждый процесc определяет свои массивы размера
C полоc и их положение
Do I = 0,Size-1
Counts(I) = ((I+1)*Nm/Size-I*Nm/Size)*Nm
Shifts(I) = I*Nm/Size*Nm
End Do
Do I = 0,Size-1
Shifts2(I) = Shifts(Rank)
Counts2(I) = Counts(Rank)
End Do
C «0» посылает всем процессам
C соответствующие полосы матриц A и В
Call MPI_SCATTERV(A(1,1), Counts, Shifts,
$ MPI_DOUBLE_PRECISION, Ac(1,1), Counts(Rank),
$ MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, Ierr)
Call MPI_SCATTERV(B(1,1), Counts, Shifts,
$ MPI_DOUBLE_PRECISION, Bc(1,1), Counts(Rank),
$ MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, Ierr)
Do K = BCol,ECol
Do I = 1,Nm
C(I,K) = Ac(I,K-BCol+1)+Bc(I,K-BCol+1)
End Do
End Do
C Каждый процесс отправляет свою рассчитанную полосу С
C и заполняет недостающие полосы данными, поступающими от
C других процессов
Call MPI_ALLTOALLV(C(1,1), Counts2, Shifts2,
$ MPI_DOUBLE_PRECISION, Cc(1,1), Counts,
$ Shifts, MPI_DOUBLE_PRECISION,
$ MPI_COMM_WORLD, Ierr)
if (Rank.eq.0) write(6,*) "A=",A