Solution 11

C

#include <stdio.h>
#include <mpi.h>
#include <stdlib.h>

int main(int argc, char **argv) { 

// Declare variables (or do it later)
 int n_proc, n_rank, i,j ;
 MPI_Datatype myvector;
 int myvector_size;
 const int n=5, nb=2;
 MPI_Aint myvector_extent, myvector_lb;
 float a[n][n];
 MPI_Status mystatus;

// Start MPI
 MPI_Init(&argc,&argv);
 MPI_Comm_size(MPI_COMM_WORLD,&n_proc);
 MPI_Comm_rank(MPI_COMM_WORLD,&n_rank);

// Check the number of processes is 2
 if(n_proc != 2) {
    if(n_rank == 0) printf("Test program has to work only with two MPI processes\n");
   MPI_Finalize();
   exit(1);
 }

// Initialize matrix
 if(n_rank == 0) for(i=0;i<n;i++) for(j=0;j<n;j++) a[i][j] = 0.F;
 if(n_rank == 1) for(i=0;i<n;i++) for(j=0;j<n;j++) a[i][j] = 1.F;

// Define vector, extract and print size and extent
 MPI_Type_vector(n, nb, n, MPI_FLOAT, &myvector);
 MPI_Type_commit(&myvector);

 MPI_Type_size(myvector, &myvector_size);
 MPI_Type_get_extent(myvector, &myvector_lb, &myvector_extent);

 printf("MPI myvector size, lb, extent: %d, %d, %d\n",
 myvector_size, myvector_lb, myvector_extent);

// Print matrix a for rank=1
 if(n_rank == 1) {
    printf("Matrix A before communications:\n");
    for(i=0;i<n;i++) {
        for(j=0;j<n;j++) {
            printf("%f ", a[i][j]);
        }
        printf("\n");
    }
 }

// Communicate
 if(n_rank == 0) {
    MPI_Send(a, 1, myvector, 1, 100, MPI_COMM_WORLD);
 }
 if(n_rank == 1) {
    MPI_Recv(a, 1, myvector, 0, 100, MPI_COMM_WORLD, &mystatus);
 }

// Print matrix a for rank=1
 if(n_rank == 1) {
    printf("Matrix A after communications:\n");
    for(i=0;i<n;i++) {
        for(j=0;j<n;j++) {
            printf("%f ", a[i][j]);
        }
        printf("\n");
    }
 }

 MPI_Type_free(&myvector);

// Finalize MPI
 MPI_Finalize();

 return 0;
}

FORTRAN

program mpi_type_vector_test

! Declare variables
use mpi
implicit none
integer :: n_proc, n_rank, ierr, i,j 
integer :: myvector, myvector_size
integer, parameter :: n=5, nb=2
integer(kind=MPI_ADDRESS_KIND) myvector_extent, myvector_lb
real :: a(n,n)
integer :: mystatus(MPI_STATUS_SIZE)

! Start MPI
call MPI_Init(ierr)
call MPI_Comm_size(MPI_COMM_WORLD,n_proc,ierr)
call MPI_Comm_rank(MPI_COMM_WORLD,n_rank,ierr)

! Check the number of processes is 2
if(n_proc /= 2) then
  if(n_rank == 0) print*,'Test program has to work only with two MPI processes'
  call MPI_Finalize(ierr)
  STOP
endif

! Initialize matrix
if(n_rank == 0) a=0
if(n_rank == 1) a=1

! Define vector, extract and print size and extent
call MPI_Type_vector(n,nb,n,MPI_REAL,myvector,ierr)
call MPI_Type_commit(myvector, ierr)

call MPI_Type_size(myvector,myvector_size,ierr)
call MPI_Type_get_extent(myvector,myvector_lb, myvector_extent,ierr)

print*,'MPI myvector size,lb,extent: ',myvector_size,myvector_lb,myvector_extent

! Print matrix a for rank=1
if(n_rank == 1) then
  print*,'Matrix A before communications:'
  do i=1,n
  do j=1,n
     write(*,'(F10.2,1X)',advance='no') a(i,j)
  enddo
  write(*,*) 
  enddo
endif

! Communicate
if(n_rank == 0) then
   call MPI_Send(a,1,myvector,1,100,MPI_COMM_WORLD, ierr)
endif
if(n_rank == 1) then
   call MPI_Recv(a,1,myvector,0,100,MPI_COMM_WORLD, mystatus, ierr)
endif

! Print matrix a for rank=1
if(n_rank == 1) then
  print*,'Matrix A after communications:'
  do i=1,n
  do j=1,n
     write(*,'(F10.2,1X)',advance='no') a(i,j)
  enddo
  write(*,*) 
  enddo
endif

call MPI_Type_free(myvector, ierr)

! Finalize MPI
call MPI_Finalize(ierr)

end program mpi_type_vector_test