******************************************************************* * This is a program for doing the summation of an array in * * each processors. * * Made by Dr. Xue-bin Chi * * Date: May 11, 2005 * * Supercomputing Center * * Computer Network Information Center, CAS * ******************************************************************* program mpi_reducing *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), root, myop, & lens(lda) real a(lda*lda), b(lda*lda), sum(lda*lda), c(lda) external userfunc *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 = lda * lda call init_vec( a, m ) if( iam .eq. 0 ) a(1) = -100 root = 0 call mpi_reduce(a, sum, m, mpi_real, mpi_min, root, comm, ierr) if( iam .eq. root ) write( *, * ) 'mpi_min', (sum(i), i=1, 4) * call zero_vec( b, m ) call mpi_op_create( userfunc, .true., myop, ierr ) call mpi_reduce(a, b, m, mpi_real, myop, root, comm, ierr) if( iam .eq. root ) write( *, * ) 'User define', (b(i), i=1, 4) call mpi_op_free( myop, ierr ) call mpi_comm_free( comm, ierr ) call mpi_finalize( ierr ) end subroutine init_vec( a, m ) integer m real a(*) integer j do 10 j=1, m a(j) = 1.0-2.0*real(mod(j, 2)) 10 continue return end subroutine userfunc( a, b, len, mpi_real ) integer len real a(len), b(len) integer i real s do 10 i=1, len s = a(i) if ( a(i) .lt. 0.0 ) s = -a(i) * if ( s .gt. b(i) ) b(i) = s b(i) = b(i) + s 10 continue return end subroutine zero_vec( b, m ) integer m real b(*) integer i do 10 i=1, m 10 b(i) = 0.0 return end

评论