Параллельные вычисления. Баканов В.М. - 121 стр.

                                                          - 121 -

СDVM$ DISTRIBUTE ( BLOCK, BLOCK) :: A
СDVM$ ALIGN B(I,J) WITH A(I,J)
С arrays A and B with block distribution
 PRINT *, '********** TEST_JACOBI **********'
 DO IT = 1, ITMAX
СDVM$ PARALLEL (J, I) ON A(I, J)
 DO J = 2, L-1
  DO I = 2, L-1
   A(I, J) = B(I, J)
 ENDDO
 ENDDO
СDVM$ PARALLEL (J, I) ON B(I, J), SHADOW_RENEW (A)
С copying shadow elements of A-array from
С neighboring processors before loop execution
 DO J = 2, L-1
   DO I = 2, L-1
   B(I, J) = (A( I-1, J ) + A( I, J-1 ) + A( I+1, J ) + A( I, J+1 )) / 4
  ENDDO
 ENDDO
 ENDDO
END

г) параллельная программа на языке Fortran с использованием MPI,
   цветом (насыщенностью) выделены относящиеся к MPI структуры
 PROGRAM JAC_MPI
 include 'mpif.h'
 integer me, nprocs
 PARAMETER (L=8, ITMAX=20, LC=2, LR=2)
 REAL A(0:L/LR+1, 0:L/LC+1), B(L/LR,L/LC)
C arrays A and B with block distribution
 integer dim(2), coords(2)
 logical isper(2)
 integer status(MPI_STATUS_SIZE, 4), req(8),newcomm
 integer srow,lrow,nrow,scol,lcol,ncol
 integer pup,pdown,pleft,pright
 dim(1) = LR
 dim(2) = LC
 isper(1) = .false.
 isper(2) = .false.
 reor = .true.
 call MPI_Init(ierr)
 call MPI_Comm_rank(mpi_comm_world, me, ierr)
 call MPI_Comm_size(mpi_comm_world, nprocs, ierr)
 call MPI_Cart_create(mpi_comm_world,2,dim,isper, .true., newcomm, ierr)
 call MPI_Cart_shift(newcomm,0,1,pup,pdown, ierr)
 call MPI_Cart_shift(newcomm,1,1,pleft,pright, ierr)
 call MPI_Comm_rank (newcomm, me, ierr)
 call MPI_Cart_coords(newcomm,me,2,coords, ierr)
C rows of matrix I have to process
 srow = (coords(1) * L) / dim(1)
 lrow = (((coords(1) + 1) * L) / dim(1))-1
 nrow = lrow - srow + 1
C colomns of matrix I have to process
 scol = (coords(2) * L) / dim(2)
 lcol = (((coords(2) + 1) * L) / dim(2))-1
 ncol = lcol - scol + 1
 call MPI_Type_vector(ncol,1,nrow+2,MPI_DOUBLE_PRECISION, vectype, ierr)
 call MPI_Type_commit(vectype, ierr)
 IF (me. eq. 0) PRINT *, '***** TEST_JACOBI *******'