program main double precision a(8,8), alocal(4,4) integer i, j, r, rank, size, sizeofdbl, ierr integer stype, t(2), vtype integer displs(2) integer blklen(2) integer sendcount(4), sdispls(4) include 'mpif.h' call MPI_Init( ierr ) call MPI_Comm_rank( MPI_COMM_WORLD, rank, ierr ) call MPI_Comm_size( MPI_COMM_WORLD, size, ierr ) if (size .ne. 4) then print *, '"This program requires exactly four processors' call MPI_Abort( MPI_COMM_WORLD, 1, ierr ) endif if (rank .eq. 0) then C Initialize the matrix. Note that C has row-major storage do 10 j=1,8 do 10 i=1,8 10 A(i,j) = 1.0 + i / 10.0d0 + j / 100.0d0 C Form the vector type for the submatrix call MPI_Type_vector( 4, 4, 8, MPI_DOUBLE_PRECISION, * vtype, ierr ) C Set an UB so that we can place this in the matrix t(1) = vtype t(2) = MPI_UB displs(1) = 0 call MPI_Type_size( MPI_DOUBLE_PRECISION, sizeofdbl, ierr ) displs(2) = 4 * sizeofdbl blklen(1) = 1 blklen(2) = 1 call MPI_Type_struct( 2, blklen, displs, t, stype, ierr ) call MPI_Type_commit( stype, ierr ) C Setup the Scatter values for the send buffer sendcount(1) = 1 sendcount(2) = 1 sendcount(3) = 1 sendcount(4) = 1 sdispls(1) = 0 sdispls(2) = 1 sdispls(3) = 8 sdispls(4) = 9 call MPI_Scatterv( A, sendcount, sdispls, stype, alocal, 4*4, * MPI_DOUBLE_PRECISION, 0, MPI_COMM_WORLD, ierr ) else call MPI_Scatterv( MPI_BOTTOM, sendcount, sdispls, stype, * alocal, 4*4, MPI_DOUBLE_PRECISION, 0, * MPI_COMM_WORLD, ierr ) endif C Everyone can now print their local matrix do r=0, size-1 if (rank .eq. r) then print *, "Output for process ", r do i=1,4 print *, (alocal(i,j),j=1,4) enddo endif call MPI_Barrier( MPI_COMM_WORLD, ierr ) enddo call MPI_Finalize( ierr ) stop end