MPI PI Tutorial

Basic “Hello World” code:

      program main

      include "mpif.h"

C      implicit real*4 (a-h,o-z)

      dimension dat(5),datt(5*8)

        call MPI_INIT(ier)

        call MPI_COMM_RANK(MPI_COMM_WORLD,myid,ier)

        call MPI_COMM_SIZE(MPI_COMM_WORLD,numprocs,ier)

      do i=0,numprocs

       print *, "Proc Num ", myid," Says Hello to Your World!!"

      enddo

      call MPI_FINALIZE(ier)

      end

MPI  Prime Number Code:

program main

! compile line:   mpif90 -integer-size 64 -lmpi -o mpi_prime prime.f90

 include 'mpif.h'

  integer ( kind = 4 ) :: i, myrank, size, ierr

  integer ( kind = 8 ) n

  integer ( kind = 8 ) n_factor

  integer ( kind = 8 ) n_hi

  integer ( kind = 8 ) n_lo

  integer ( kind = 8 ) primes

  integer ( kind = 8 ) primes_part

  real ( kind = 8 ) wtime

  n_lo = 1

  n_hi = 1310720000005632

  n_factor = 2

!

!  Initialize MPI.

!

  call MPI_Init ( ierr )

!

!  Get this process's ID.

!

  call MPI_Comm_rank ( MPI_COMM_WORLD, myrank, ierr )

!

!  Find out how many processes are available.

!

  call MPI_Comm_size ( MPI_COMM_WORLD, size, ierr )

  if ( myrank == 0 ) then

    write ( *, '(a,i8)' ) '  The number of MPI ranks is ', size

    write ( *, '(a)' ) ' '

    write ( *, '(a)' ) '         N        Prime   Time'

    write ( *, '(a)' ) ' '

  end if

  n = n_lo

  do while ( n <= n_hi )

    if ( myrank  == 0 ) then

      wtime = MPI_Wtime ( )

    end if

    call MPI_Bcast ( n, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr )

    call prime_number ( n, myrank, size, primes_part )

    call MPI_Reduce ( primes_part, primes, 1, MPI_INTEGER, MPI_SUM, 0, &

      MPI_COMM_WORLD, ierr )

    if ( myrank == 0 ) then

      wtime = MPI_Wtime ( ) - wtime

      write ( *, '(2x,i8,2x,i8,g14.6)' ) n, primes, wtime

    end if

    n = n * n_factor

  end do

!

!  Terminate MPI.

!

  call MPI_Finalize ( ierr )

!

!  Terminate.

!

  if ( myrank  == 0 ) then

    write ( *, '(a)' ) ' '

    write ( *, '(a)' ) "Finished "

  end if

  stop

end

subroutine prime_number ( n, myrank, size, total )

  implicit none

  integer ( kind = 4 ) :: i, j, myrank, size

  integer ( kind = 8 ) n

  integer ( kind = 8 ) prime

  integer ( kind = 8 ) total

  total = 0

  do i = 2+myrank, n, size

    prime = 1

    do j = 2, i - 1

      if ( mod ( i, j ) == 0 ) then

        prime = 0

        exit

      end if

    end do

    total = total + prime

  end do

  return

end

Note: MPI_Reduce

 

PBS Script:

#PBS -l nodes=2:ppn=4,walltime=2:00:00

#PBS -m ae

#PBS -N test_mpi_prime

#PBS -o /N/dc/scratch/hpstrnXX/mpi/prime/mpi_prime_test.out

#PBS -e /N/dc/scratch/hpstrnXX/mpi/prime/mpi_prime_test.err

#

cd /N/dc/scratch/hpstrnXX/mpi/prime

time mpirun -np 8 -machinefile  $PBS_NODEFILE prime

 

MPI Pi Code:

function  funct(dummy) result(dumdum)

    real(kind=8) :: dummy, dumdum

    dumdum = 4.d0 / (1.d0 + dummy * dummy)

end function funct

    program compute_mpi_pi

!

! compile line:  mpif90 -integer-size 64 -lmpi -o mpi_pi mpi_pi.f90

!

 include "mpif.h"

!

 integer ::  i

 integer(kind = 8)  :: interval

 real(kind=8) ::  width, partial, sum, pi, dummy

 real(kind=8) ::  funct

 integer :: ier, myid, numprocs

 real(kind=8) :: mypi

!

 call MPI_INIT(ier)

 call MPI_COMM_RANK(MPI_COMM_WORLD,myid,ier)

 call MPI_COMM_SIZE(MPI_COMM_WORLD,numprocs,ier)

!

! Sum of intervals equals one

!

 interval = 800000000000

 width = 1.d0 / interval

 sum = 0.d0

 !!  do i = 1, interval

 do i = myid+1, interval, numprocs

    partial = width * (i - 0.5d0)

    sum = sum + funct(partial)

 enddo

 mypi = width * sum

 call MPI_REDUCE(mypi,pi,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, MPI_COMM_WORLD,ier)

 if (myid .EQ. 0) then

    print *, "computed pi =", pi

    print *, "reference pi = 3.1415926535897932385"

 endif

 call MPI_FINALIZE(ier)

 stop

 end program compute_mpi_pi

Note: “MPI_Reduce

 

PBS Script:

#PBS -l nodes=2:ppn=6,walltime=30:00

#PBS -m ae

#PBS -N test_pbs

#PBS -o /N/dc/scratch/hpstrnXX/mpi/pi/mpi_pi_test.out

#PBS -e /N/dc/scratch/hpstrnXX/mpi/pi/mpi_pi_test.err

#

cd /N/dc/scratch/hpstrnXX/mpi/pi

time mpirun -np 12 -machinefile  $PBS_NODEFILE mpi_pi