******************************************************************* * This is a program for defining a new data type to transfer * * an upper trangular matrix. * * Made by Dr. Xue-bin Chi * * Date: April 27, 2005 * * Supercomputing Center * * Computer Network Information Center, CAS * ******************************************************************* program define_new_upper *The header file for using MPI parallel environment, which must be *included for all mpi programs. include 'mpif.h' *Variables declaration integer iam, np, comm, ierr integer lda parameter ( lda = 20 ) integer i, m, status(mpi_status_size), & lens(lda), disp(lda) real a(lda, lda) *Enroll in MPI environment and get the MPI parameters call mpi_init(ierr) call mpi_comm_dup(mpi_comm_world, comm, ierr) call mpi_comm_rank(comm, iam, ierr) call mpi_comm_size(comm, np, ierr) print *, 'Process ', iam, ' of ', np, ' is running!' m =15 do 10 i=1, m lens(i) = i disp(i) = (i-1)*lda 10 continue call mpi_type_indexed( m, lens, disp, mpi_real, newtype, & ierr ) call mpi_type_commit( newtype, ierr ) if ( np .lt. 2 ) stop if ( iam .eq. 0 ) then call init_mat( a, lda, m ) call mpi_send( a, 1, newtype, 1, 1, comm, ierr ) elseif ( iam .eq. 1 ) then call mpi_recv( a, 1, newtype, 0, 1, comm, status, ierr ) write( *, * ) (a(i, i), i=1, m ) endif call mpi_type_free( newtype, ierr ) call mpi_finalize( ierr ) end subroutine init_mat( a, lda, m ) integer lda, m real a(lda, *) integer i, j do 10 j=1, m do 10 i=1, j a(i, j) = real(i+j) 10 continue return end

评论