Pacheco 本の最初の方を勉強した昔のノートが出てきたのでｗ

Fortran90 風に書いたもの。

PROGRAM test1
USE mpi
IMPLICIT NONE
INTEGER :: istatus(MPI_STATUS_SIZE)
INTEGER :: ierr, idest, itag = 0
INTEGER :: irank, nrank, isource, mess
CHARACTER(LEN = 40) :: message 

CALL MPI_INIT( ierr )

CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nrank, ierr)

IF (irank /= 0) THEN
 WRITE(message, '(a, i2)') 'Greetings from process ', irank
 idest = 0
 CALL MPI_SEND(message, LEN(message), MPI_CHARACTER, idest, itag, MPI_COMM_WORLD, ierr)  
ELSE
 DO isource = 1, nrank - 1
  CALL MPI_RECV(message, LEN(message), MPI_CHARACTER, isource, itag, MPI_COMM_WORLD, istatus, ierr) 
  WRITE(*, *) message
 END DO
END IF

IF (irank == 0) PAUSE

CALL MPI_FINALIZE( ierr )

STOP
END PROGRAM test1

PROGRAM test2
USE mpi
IMPLICIT NONE
INTEGER :: istatus(MPI_STATUS_SIZE)
INTEGER :: ierr, idest, itag = 0
INTEGER :: irank, nrank, isource
CHARACTER(LEN = 40) :: message 

CALL MPI_INIT( ierr )

CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nrank, ierr)

IF (irank /= 0) THEN
 WRITE(message, '(a, i2)') 'Greetings from process ', irank
 idest = 0
 CALL MPI_SEND(message, LEN(message), MPI_CHARACTER, idest, itag, MPI_COMM_WORLD, ierr)  
ELSE
 DO isource = 1, nrank - 1
  CALL MPI_RECV(message, LEN(message), MPI_CHARACTER, MPI_ANY_SOURCE, itag, MPI_COMM_WORLD, istatus, ierr) 
  WRITE(*, '(a, 3i3)') message, istatus(MPI_SOURCE), istatus(MPI_TAG), istatus(MPI_ERROR)
 END DO
END IF

IF (irank == 0) PAUSE

CALL MPI_FINALIZE( ierr )

STOP
END PROGRAM test2

PROGRAM test3
USE mpi
IMPLICIT NONE
INTEGER :: istatus(MPI_STATUS_SIZE)
INTEGER :: ierr, idest, itag = 0
INTEGER :: irank, nrank, isource
CHARACTER(LEN = 40) :: message 

CALL MPI_INIT( ierr )

CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nrank, ierr)

WRITE(message, '(a, i2)') 'Greetings from process ', irank

idest = MOD(irank + 1, nrank)
CALL MPI_SEND(message, LEN(message), MPI_CHARACTER, idest  , itag, MPI_COMM_WORLD, ierr)  

isource = MOD(irank - 1 + nrank, nrank)
CALL MPI_RECV(message, LEN(message), MPI_CHARACTER, isource, itag, MPI_COMM_WORLD, istatus, ierr) 

WRITE(*, '(a, 4i3)') message, irank, istatus(MPI_SOURCE), istatus(MPI_TAG), istatus(MPI_ERROR)

IF (irank == 0) PAUSE

CALL MPI_FINALIZE( ierr )

STOP
END PROGRAM test3

PROGRAM test4
USE mpi
IMPLICIT NONE
INTEGER :: istatus(MPI_STATUS_SIZE)
INTEGER :: ierr, idest, itag = 0
INTEGER :: irank, nrank, isource
INTEGER :: n = 4 * 1024, n_local
REAL :: a, b, h, a_local, b_local, xintegral, total

CALL MPI_INIT( ierr )
CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, nrank, ierr)

a = 0.0
b = 1.0
h = (b - a) / REAL(n)

n_local = n / nrank
a_local = a + real(irank * n_local) * h
b_local = a_local + REAL(n_local) * h
xintegral = trap(a_local, b_local, n_local, h)

IF (irank == 0) THEN
 total = xintegral
 DO isource = 1, nrank - 1
  CALL MPI_RECV(xintegral, 1, MPI_REAL, MPI_ANY_SOURCE, itag, MPI_COMM_WORLD, istatus, ierr)
  total = total + xintegral
 END DO
ELSE
 idest = 0
 CALL MPI_SEND(xintegral, 1, MPI_REAL, idest, itag, MPI_COMM_WORLD, ierr)
END IF

IF (irank == 0) THEN
 WRITE(*, '(a, i5, a)') ' With n =', n, ' trapezoids, our estimate'
 WRITE(*, '(a, f6.3, a, f6.3, a, f15.7)') ' of the integral from', a, ' to', b, ' =', total
 PAUSE
END IF

CALL MPI_FINALIZE( ierr )

STOP
CONTAINS
!-------------------------------------
 REAL FUNCTION trap(a, b, n, h)
 REAL, INTENT(IN) :: a, b, h
 INTEGER, INTENT(IN) :: n
 REAL :: x
 INTEGER :: i
 trap = 0.5 * ( f(a) + f(b) )
 DO i = 1, n - 1
  x = a + REAL(i) * h
  trap = trap + f(x)
 END DO
 trap = trap * h
 !print *, '=a=b=h=I==>', a, b, h, ':', trap
 RETURN
 END FUNCTION trap
!-------------------------------------
 REAL FUNCTION f(x)
 REAL, PARAMETER :: pi = 4.0 * ATAN(1.0)
 REAL, INTENT(IN) :: x
 REAL :: res
 f = SIN(x * pi) * pi
 RETURN
 END FUNCTION f 
!-------------------------------------
END PROGRAM test4