******************************************************************* * This is a program for testing struct defined data type * * Made by Dr. Xue-bin Chi * * Date: April 30, 2005 * * Supercomputing Center * * Computer Network Information Center, CAS * ******************************************************************* program define_struct *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, maxblk parameter ( lda = 20, maxblk = 5 ) integer i, m, status(mpi_status_size), newtype, & lens(lda), blclen(maxblk), types(maxblk), displs(maxblk) real a(lda) character*20 c *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 if ( iam .eq. 0 ) then do 10 i=1, m lens(i) = i a(i) = (i-1)*lda 10 continue c = "your name?" endif blclen(1) = 9 blclen(2) = 5 blclen(3) = 4 types(1) = mpi_integer types(2) = mpi_real types(3) = mpi_character call mpi_address(lens(3), displs(1), ierr ) call mpi_address(a(2), displs(2), ierr ) call mpi_address(c, displs(3), ierr ) do 20 i=3, 1, -1 displs(i) = displs(i)-displs(1) 20 continue call mpi_type_struct( 3, blclen, displs, types, newtype, & ierr ) call mpi_type_commit( newtype, ierr ) if ( np .lt. 2 ) stop if ( iam .eq. 0 ) then call mpi_send( lens(3), 1, newtype, 1, 1, comm, ierr ) elseif ( iam .eq. 1 ) then call mpi_recv(lens(3), 1, newtype, 0, 1, comm, status, ierr) write( *, * ) (a(i), i=2, blclen(2)+1), c(1:4) write( *, * ) (lens(i), i=3, blclen(1)+2) 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

评论