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

Compaq のテキストより その２

昔学んだテキストが出てきたので、f90 で書き直してみたりしなかったりします。

http://h50146.www5.hp.com/solutions/hpc/stc/soft/mpi.html
MPIプログラミング入門
http://h50146.www5.hp.com/solutions/hpc/stc/soft/pdfs/mpi_training.pdf　（PDF直リン）

C:\program files\MPICH2\bin\mpiexec.exe -localonly 2 $(TargetPath) ****.exe

スレッド数は適宜調整のこと。

• 例題 3-4d

PROGRAM mpi_3
USE mpi
IMPLICIT NONE
INTEGER, PARAMETER :: nprocs = 3, nmax = 12 / nprocs
INTEGER :: mstatus(MPI_STATUS_SIZE)
INTEGER :: n(0:nmax + 1), na(0:nmax + 1)
INTEGER :: i, isize, irank, ierr, iLF, iRT, ireq1, ireq2

CALL MPI_INIT(ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
IF (isize /= nprocs) THEN
 CALL MPI_FINALIZE(ierr)
 STOP 
END IF
DO i = 1, nmax
 n(i) = irank * nmax + i
END DO

iLF = irank - 1
IF (irank == 0) iLF = MPI_PROC_NULL
iRT = irank + 1
IF (irank == isize - 1) iRT = MPI_PROC_NULL

CALL MPI_SENDRECV(n(nmax), 1, MPI_INTEGER, iRT, 1, &
                  n(0)    , 1, MPI_INTEGER, iLF, 1, &
                  MPI_COMM_WORLD, mstatus, ierr)

CALL MPI_SENDRECV(n(1)      , 1, MPI_INTEGER, iLF, 1, &
                  n(nmax + 1), 1, MPI_INTEGER, iRT, 1, &
                  MPI_COMM_WORLD, mstatus, ierr)

DO i = 1, nmax
 na(i) = n(i - 1) + n(i) + n(i + 1)
END DO

PRINT *, 'rank[', irank, '] : ', (na(i), i = 1, nmax)

IF (irank == 0) PAUSE

CALL MPI_FINALIZE(ierr)
STOP
END PROGRAM mpi_3

• 例題 4-3a

PROGRAM test
USE mpi
IMPLICIT NONE
INTEGER :: mstatus(MPI_STATUS_SIZE)
INTEGER :: n(12) = 0
INTEGER :: i, isize, irank, ierr, inewvec

CALL MPI_INIT(ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, irank, ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, isize, ierr)
IF (irank == 0) n = [ (i, i = 1, 12) ]

CALL MPI_TYPE_VECTOR(3, 2, 3, MPI_INTEGER, inewvec, ierr)
CALL MPI_TYPE_COMMIT(inewvec, ierr)

SELECT CASE(irank)
 CASE(0)

  CALL MPI_SEND(n(1), 1, inewvec, 1, 1, MPI_COMM_WORLD, ierr) 

 CASE(1)

  CALL MPI_RECV(n(2), 1, inewvec, 0, 1, MPI_COMM_WORLD, mstatus, ierr) 

 CASE DEFAULT
  STOP 'error'
END SELECT

PRINT '(a, i2, 2x, 12i3)', 'rank:', irank, n(:)

CALL MPI_TYPE_FREE(inewvec, ierr)
IF (irank == 0) PAUSE
CALL MPI_FINALIZE(ierr)
STOP
!------------------------------------
END PROGRAM test

• 例題 4-3b

PROGRAM mpi4
USE mpi
IMPLICIT NONE
INTEGER, PARAMETER :: imax = 8, jmax = 8
INTEGER :: mstatus(MPI_STATUS_SIZE)
INTEGER :: i, j, ilen, jlen, n(imax, jmax) = 0
INTEGER :: isize, irank, ierr, isubmtx

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

IF (irank == 0) THEN
 DO i = 1, imax
  DO j = 1, jmax
    n(i, j) = 100 * i + j
  END DO
 END DO
END IF

ilen = 4
jlen = 4
CALL MPI_TYPE_VECTOR(jlen, ilen, imax, MPI_INTEGER, isubmtx, ierr)
CALL MPI_TYPE_COMMIT(isubmtx, ierr)

SELECT CASE(irank)
 CASE(0)

   CALL MPI_SEND(n(1, 5), 1, isubmtx, 1, 1, MPI_COMM_WORLD, ierr) 

 CASE(1)

   CALL MPI_RECV(n(5, 1), 1, isubmtx, 0, 1, MPI_COMM_WORLD, mstatus, ierr) 

 CASE DEFAULT
  STOP 'error'
END SELECT

PRINT '(a, i2)', 'rank:', irank
PRINT '(8i4)', ((n(i, j), j = 1, 8), i = 1, 8)

CALL MPI_TYPE_FREE(isubmtx, ierr)

IF (irank == 0) PAUSE

CALL MPI_FINALIZE(ierr)
STOP
END PROGRAM mpi4

• 4-4

PROGRAM mpi4
USE mpi
IMPLICIT NONE
INTEGER, PARAMETER :: mmax = 16, nmax = 16, mm = mmax / 4
INTEGER :: mstatus(MPI_STATUS_SIZE)
INTEGER :: i, j, ilen, jlen, n(0:mm + 1, 0:nmax + 1), m(0:mm + 1, 0:nmax + 1)
INTEGER :: iup, idw, isize, irank, ierr, inewvec

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

 DO i = 1, nmax
  DO j = 1, mm
    n(j, i) = i + 100 * j !+ 1000 * irank 
  END DO
 END DO

CALL MPI_TYPE_VECTOR(nmax, 1, mm + 2, MPI_INTEGER, inewvec, ierr)
CALL MPI_TYPE_COMMIT(inewvec, ierr)

iup = irank - 1 
IF (irank == 0) iup = 3
idw = irank + 1
IF (irank == isize - 1) idw = 0

CALL MPI_SENDRECV(n(mm, 1), 1, inewvec, idw, 1, n(0     ,  1), 1, inewvec, iup, 1, MPI_COMM_WORLD, mstatus, ierr) 
CALL MPI_SENDRECV(n( 1, 1), 1, inewvec, iup, 1, n(mm + 1,  1), 1, inewvec, idw, 1, MPI_COMM_WORLD, mstatus, ierr) 


DO i = 1, mm
 n(i, 0       ) = n(i, nmax)
 n(i, nmax + 1) = n(i, i)
END DO

DO j = 1, nmax
 DO i = 1, mm 
  m(i, j) = n(i - 1, j) + n(i, j - 1) + n(i, j + 1) + n(i + 1, j)
 END DO
END DO

IF (irank == 2) THEN
 PRINT '(a, i2)', 'irank:', irank
 PRINT '(18i5)' , ((m(i, j), j = 0, nmax + 1), i = 0, mm + 1)
END IF

CALL MPI_TYPE_FREE(inewvec, ierr)

IF (irank == 0) PAUSE
CALL MPI_FINALIZE(ierr)
STOP
!------------------------------------
END PROGRAM mpi4

PROGRAM mpi4
USE mpi
IMPLICIT NONE
LOGICAL :: period(2)
INTEGER :: idivid(2), iud(2), ilr(2), idisp(2), narg, nainfo(3)
INTEGER :: i, isize, irank, ierr, iptbl
CHARACTER(16) :: argv

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

narg = COMMAND_ARGUMENT_COUNT()
IF (narg == 3) THEN
 DO i = 1, narg
  CALL GET_COMMAND_ARGUMENT(i, argv)
  READ(argv, '(i)') nainfo(i)
 END DO 
ELSE
 PRINT *, 'input error: COMMAND  rank i j'
 STOP
END IF 

idivid(1) = 4
idivid(2) = 4
period(1) = .FALSE.
period(2) = .FALSE.

CALL MPI_CART_CREATE(MPI_COMM_WORLD, 2, idivid, period, .FALSE., iptbl, ierr)

idisp(1) = nainfo(2)
idisp(2) = nainfo(3)

CALL MPI_CART_SHIFT(iptbl, 0, idisp(1), iud(1), iud(2), ierr)
CALL MPI_CART_SHIFT(iptbl, 1, idisp(2), ilr(1), ilr(2), ierr)

IF ( irank == nainfo(1) ) THEN
  PRINT '(3x, i3)', iud(1)
  PRINT '(3i3)', ilr(1), irank, ilr(2)
  PRINT '(3x, i3)', iud(2)
END IF

CALL MPI_COMM_FREE(iptbl, ierr)
IF (irank == 0) PAUSE
CALL MPI_FINALIZE(ierr)
STOP
END PROGRAM mpi4

PROGRAM mpi4
USE mpi
IMPLICIT NONE
INTEGER, PARAMETER :: mdiv = 3, ndiv = 4
INTEGER, PARAMETER :: mm = 12, nn = 16
INTEGER, PARAMETER :: mmax = mm / 3, nmax = nn / 4 
LOGICAL :: period(2)
INTEGER :: mstatus(MPI_STATUS_SIZE)
INTEGER :: idivid(2), iup, idw, ilf, irt
INTEGER :: ia(0:mmax + 1, 0:nmax + 1), ib(0:mmax + 1, 0:nmax + 1)
INTEGER :: i, j, isize, irank, ierr, inewvec, iptbl

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

idivid(1) = mdiv
idivid(2) = ndiv
period(1) = .TRUE.
period(2) = .TRUE.

CALL MPI_CART_CREATE(MPI_COMM_WORLD, 2, idivid, period, .FALSE., iptbl, ierr)

CALL MPI_CART_SHIFT(iptbl, 0, 1, iup, idw, ierr)
CALL MPI_CART_SHIFT(iptbl, 1, 1, ilf, irt, ierr)

CALL MPI_TYPE_VECTOR(nmax, 1, nmax + 2, MPI_INTEGER, inewvec, ierr)
CALL MPI_TYPE_COMMIT(inewvec, ierr)

DO j = 1, nmax
 DO i = 1, mmax
  ia(i, j) = i + j * 100
 END DO
END DO 

CALL MPI_SENDRECV(ia(nmax,    1),    1, inewvec, idw, 1, ia(0       , 1),    1, inewvec, iup, 1, MPI_COMM_WORLD, mstatus, ierr)
CALL MPI_SENDRECV(ia(   1,    1),    1, inewvec, iup, 1, ia(nmax + 1, 1),    1, inewvec, idw, 1, MPI_COMM_WORLD, mstatus, ierr)
CALL MPI_SENDRECV(ia(   1, nmax), mmax, MPI_INTEGER, irt, 1, ia(1       , 0), mmax, MPI_INTEGER, ilf, 1, MPI_COMM_WORLD, mstatus, ierr)
CALL MPI_SENDRECV(ia(   1,    1), mmax, MPI_INTEGER, ilf, 1, ia(1, nmax + 1), mmax, MPI_INTEGER, irt, 1, MPI_COMM_WORLD, mstatus, ierr)

DO j = 1, nmax
 DO i = 1, mmax
  ib(i, j) = ia(i - 1, j) + ia(i, j - 1) + ia(i, j + 1) + ia(i + 1, j)
 END DO
END DO   

!IF ( irank == 0 ) THEN
!  PRINT '(6i4)', TRANSPOSE(ia)
!END IF

IF ( irank == 0 ) THEN
  PRINT '(6i4)', TRANSPOSE(ib)
END IF


CALL MPI_COMM_FREE(iptbl, ierr)
CALL MPI_TYPE_FREE(inewvec, ierr)
IF (irank == 0) PAUSE
CALL MPI_FINALIZE(ierr)
STOP
END PROGRAM mpi4

最小

昔、ならった MPI プログラムを F90 で書きなおしてみるかな・・
F90 のモジュールになったけど、サブルーチンの引数チェックなどインターフェースは完全ではないみたい？

PROGRAM mpi_2
USE mpi
IMPLICIT NONE
INTEGER :: ierr
CALL MPI_INIT(ierr)

PRINT *, 'Uho!'

CALL MPI_FINALIZE(ierr)
STOP
END PROGRAM mpi_2

• 実行結果

• リンカーのオプション他

x64用の*.MODファイルの不在について

x64 Windows 用の MPICH2 のバイナリをインストーラからインストールすると、Include ディレクトリに F90 でプログラムする時の USE MPI で引く複数の MOD ファイルが欠落しています。Win32 版には入っているので何かの手違いかと思います。

ソースからコンパイルすると、Project file の設定の問題だと思うのですが、x64 用をコンパイルした場合にも Win32 用のディレクトリに *.MOD ファイルが構成されてしまいます。この事が原因ではなかろうかと推測します。

x64 用の MOD ファイルはヘッダーファイルをコンパイルしただけのものなので、ソースから簡単に作り出せるのではないかと思ったのですが、Win32 用と x64 用のソースを、種ファイルからスクリプトで形成しているようで、単にソース用のアーカイブファイルを展開しただけでは作り出せませんでした。

一方で、きちんとした手順でコンパイルして構成するには、Windows Developer's Guide　http://www.mcs.anl.gov/research/projects/mpich2/documentation/index.php?s=docs に従って、かなりの手間隙をかけてやらなければなりませんでした。

• 備忘録
• mpi.f90 （以下の３ファイルを引用）
• mpi_base.f90　　 　
• mpi_constants.f90 =(INCLUDE)=> mpifnoext.h （include/win64 に、スクリプトで生成？）
• mpi_sizeofs.f90　（スクリプトで生成）

これら４つのファイルをコンパイルして出来た *.MOD ファイルを、バイナリ配布用のインストーラがつくり出した Include ディレクトリに放り込めば、x64 版でも INCLUDE mpif.h の代わりに USE MPI を使えると思います。

以下に Intel Visual Fortran x64 用に、生成された mpi_sizeofs.f90 と mpifnoex.h のリストをば。

! -*- Mode: F90; -*- 
!
!  (C) 2004 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!
       MODULE MPI_SIZEOFS
!      This module contains the definitions for MPI_SIZEOF for the
!      predefined, named types in Fortran 90.  This is provided
!      as a separate module to allow MPI_SIZEOF to supply the
!      basic size information even when we do not provide the
!      arbitrary choice types
       IMPLICIT NONE
!
       PUBLIC :: MPI_SIZEOF
       INTERFACE MPI_SIZEOF
           MODULE PROCEDURE MPI_SIZEOF_I, MPI_SIZEOF_R,                &
     &                      MPI_SIZEOF_L, MPI_SIZEOF_CH, MPI_SIZEOF_CX,&
     &           MPI_SIZEOF_IV, MPI_SIZEOF_RV,                         &
     &           MPI_SIZEOF_LV, MPI_SIZEOF_CHV, MPI_SIZEOF_CXV
           MODULE PROCEDURE MPI_SIZEOF_D, MPI_SIZEOF_DV
          MODULE PROCEDURE MPI_SIZEOF_I1, MPI_SIZEOF_I1V
          MODULE PROCEDURE MPI_SIZEOF_I2, MPI_SIZEOF_I2V
          MODULE PROCEDURE MPI_SIZEOF_I8, MPI_SIZEOF_I8V
       END INTERFACE ! MPI_SIZEOF
!
       CONTAINS
!
       SUBROUTINE MPI_SIZEOF_I( X, SIZE, IERROR )
       INTEGER X
       INTEGER SIZE, IERROR
       SIZE = 4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_I
!
       SUBROUTINE MPI_SIZEOF_R( X, SIZE, IERROR )
       REAL X
       INTEGER SIZE, IERROR
       SIZE = 4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_R
!
! If reals and doubles have been forced to the same size (e.g., with 
! -i8 -r8 to compilers like g95), then the compiler may refuse to 
! allow interfaces that use real and double precision (failing to 
! determine which one is intended)
       SUBROUTINE MPI_SIZEOF_D( X, SIZE, IERROR )
       DOUBLE PRECISION X
       INTEGER SIZE, IERROR
       SIZE = 8
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_D
!
       SUBROUTINE MPI_SIZEOF_L( X, SIZE, IERROR )
       LOGICAL X
       INTEGER SIZE, IERROR
       SIZE = 4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_L
!
       SUBROUTINE MPI_SIZEOF_CH( X, SIZE, IERROR )
       CHARACTER X
       INTEGER SIZE, IERROR
       SIZE = 1
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_CH
!
       SUBROUTINE MPI_SIZEOF_CX( X, SIZE, IERROR )
       COMPLEX X
       INTEGER SIZE, IERROR
       SIZE = 2*4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_CX
!
       SUBROUTINE MPI_SIZEOF_IV( X, SIZE, IERROR )
       INTEGER X(*)
       INTEGER SIZE, IERROR
       SIZE = 4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_IV
!
       SUBROUTINE MPI_SIZEOF_RV( X, SIZE, IERROR )
       REAL X(*)
       INTEGER SIZE, IERROR
       SIZE = 4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_RV
!
! If reals and doubles have been forced to the same size (e.g., with 
! -i8 -r8 to compilers like g95), then the compiler may refuse to 
! allow interfaces that use real and double precision (failing to 
! determine which one is intended)
       SUBROUTINE MPI_SIZEOF_DV( X, SIZE, IERROR )
       DOUBLE PRECISION X(*)
       INTEGER SIZE, IERROR
       SIZE = 8
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_DV
!
       SUBROUTINE MPI_SIZEOF_LV( X, SIZE, IERROR )
       LOGICAL X(*)
       INTEGER SIZE, IERROR
       SIZE = 4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_LV
!
       SUBROUTINE MPI_SIZEOF_CHV( X, SIZE, IERROR )
       CHARACTER X(*)
       INTEGER SIZE, IERROR
       SIZE = 1
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_CHV
!
       SUBROUTINE MPI_SIZEOF_CXV( X, SIZE, IERROR )
       COMPLEX X(*)
       INTEGER SIZE, IERROR
       SIZE = 2*4
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_CXV
!
! Support for the optional Integer*8 type
! Note that we may want to replace this with code that handles
! MPI_OFFSET_KIND or MPI_ADDRESS_KIND integers
       SUBROUTINE MPI_SIZEOF_I8( X, SIZE, IERROR )
       INTEGER*8 X
       INTEGER SIZE, IERROR
       SIZE = 8
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_I8
       SUBROUTINE MPI_SIZEOF_I8V( X, SIZE, IERROR )
       INTEGER*8 X(*)
       INTEGER SIZE, IERROR
       SIZE = 8
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_I8V
!
       SUBROUTINE MPI_SIZEOF_I1( X, SIZE, IERROR )
       INTEGER*1 X
       INTEGER SIZE, IERROR
       SIZE = 1
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_I1
       SUBROUTINE MPI_SIZEOF_I1V( X, SIZE, IERROR )
       INTEGER*1 X(*)
       INTEGER SIZE, IERROR
       SIZE = 1
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_I1V
!
       SUBROUTINE MPI_SIZEOF_I2( X, SIZE, IERROR )
       INTEGER*2 X
       INTEGER SIZE, IERROR
       SIZE = 2
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_I2
       SUBROUTINE MPI_SIZEOF_I2V( X, SIZE, IERROR )
       INTEGER*2 X(*)
       INTEGER SIZE, IERROR
       SIZE = 2
       IERROR = 0
       END SUBROUTINE MPI_SIZEOF_I2V
! 
!
! We don't include double complex.  If we did, we'd need to include the
! same hack as for real and double above if the compiler has been forced
! to make them the same size.
       END MODULE MPI_SIZEOFS

!      /* -*- Mode: Fortran; -*- */
!      
!      (C) 2001 by Argonne National Laboratory.
!      See COPYRIGHT in top-level directory.
!      
!      DO NOT EDIT
!      This file created by buildiface 
!      
       INTEGER MPI_SOURCE, MPI_TAG, MPI_ERROR
       PARAMETER (MPI_SOURCE=3,MPI_TAG=4,MPI_ERROR=5)
       INTEGER MPI_STATUS_SIZE
       PARAMETER (MPI_STATUS_SIZE=5)
       INTEGER MPI_STATUS_IGNORE(MPI_STATUS_SIZE)
       INTEGER MPI_STATUSES_IGNORE(MPI_STATUS_SIZE,1)
       INTEGER MPI_ERRCODES_IGNORE(1)
       CHARACTER*1 MPI_ARGVS_NULL(1,1)
       CHARACTER*1 MPI_ARGV_NULL(1)
       INTEGER MPI_SUCCESS
       PARAMETER (MPI_SUCCESS=0)
       INTEGER MPI_ERR_OTHER
       PARAMETER (MPI_ERR_OTHER=15)
       INTEGER MPI_ERR_WIN
       PARAMETER (MPI_ERR_WIN=45)
       INTEGER MPI_ERR_FILE
       PARAMETER (MPI_ERR_FILE=27)
       INTEGER MPI_ERR_COUNT
       PARAMETER (MPI_ERR_COUNT=2)
       INTEGER MPI_ERR_SPAWN
       PARAMETER (MPI_ERR_SPAWN=42)
       INTEGER MPI_ERR_BASE
       PARAMETER (MPI_ERR_BASE=46)
       INTEGER MPI_ERR_RMA_CONFLICT
       PARAMETER (MPI_ERR_RMA_CONFLICT=49)
       INTEGER MPI_ERR_IN_STATUS
       PARAMETER (MPI_ERR_IN_STATUS=17)
       INTEGER MPI_ERR_INFO_KEY
       PARAMETER (MPI_ERR_INFO_KEY=29)
       INTEGER MPI_ERR_LOCKTYPE
       PARAMETER (MPI_ERR_LOCKTYPE=47)
       INTEGER MPI_ERR_OP
       PARAMETER (MPI_ERR_OP=9)
       INTEGER MPI_ERR_ARG
       PARAMETER (MPI_ERR_ARG=12)
       INTEGER MPI_ERR_READ_ONLY
       PARAMETER (MPI_ERR_READ_ONLY=40)
       INTEGER MPI_ERR_SIZE
       PARAMETER (MPI_ERR_SIZE=51)
       INTEGER MPI_ERR_BUFFER
       PARAMETER (MPI_ERR_BUFFER=1)
       INTEGER MPI_ERR_DUP_DATAREP
       PARAMETER (MPI_ERR_DUP_DATAREP=24)
       INTEGER MPI_ERR_UNSUPPORTED_DATAREP
       PARAMETER (MPI_ERR_UNSUPPORTED_DATAREP=43)
       INTEGER MPI_ERR_LASTCODE
       PARAMETER (MPI_ERR_LASTCODE=1073741823)
       INTEGER MPI_ERR_TRUNCATE
       PARAMETER (MPI_ERR_TRUNCATE=14)
       INTEGER MPI_ERR_DISP
       PARAMETER (MPI_ERR_DISP=52)
       INTEGER MPI_ERR_PORT
       PARAMETER (MPI_ERR_PORT=38)
       INTEGER MPI_ERR_INFO_NOKEY
       PARAMETER (MPI_ERR_INFO_NOKEY=31)
       INTEGER MPI_ERR_ASSERT
       PARAMETER (MPI_ERR_ASSERT=53)
       INTEGER MPI_ERR_FILE_EXISTS
       PARAMETER (MPI_ERR_FILE_EXISTS=25)
       INTEGER MPI_ERR_PENDING
       PARAMETER (MPI_ERR_PENDING=18)
       INTEGER MPI_ERR_COMM
       PARAMETER (MPI_ERR_COMM=5)
       INTEGER MPI_ERR_KEYVAL
       PARAMETER (MPI_ERR_KEYVAL=48)
       INTEGER MPI_ERR_NAME
       PARAMETER (MPI_ERR_NAME=33)
       INTEGER MPI_ERR_REQUEST
       PARAMETER (MPI_ERR_REQUEST=19)
       INTEGER MPI_ERR_GROUP
       PARAMETER (MPI_ERR_GROUP=8)
       INTEGER MPI_ERR_TOPOLOGY
       PARAMETER (MPI_ERR_TOPOLOGY=10)
       INTEGER MPI_ERR_TYPE
       PARAMETER (MPI_ERR_TYPE=3)
       INTEGER MPI_ERR_TAG
       PARAMETER (MPI_ERR_TAG=4)
       INTEGER MPI_ERR_INFO_VALUE
       PARAMETER (MPI_ERR_INFO_VALUE=30)
       INTEGER MPI_ERR_NOT_SAME
       PARAMETER (MPI_ERR_NOT_SAME=35)
       INTEGER MPI_ERR_RMA_SYNC
       PARAMETER (MPI_ERR_RMA_SYNC=50)
       INTEGER MPI_ERR_INFO
       PARAMETER (MPI_ERR_INFO=28)
       INTEGER MPI_ERR_NO_MEM
       PARAMETER (MPI_ERR_NO_MEM=34)
       INTEGER MPI_ERR_BAD_FILE
       PARAMETER (MPI_ERR_BAD_FILE=22)
       INTEGER MPI_ERR_FILE_IN_USE
       PARAMETER (MPI_ERR_FILE_IN_USE=26)
       INTEGER MPI_ERR_UNKNOWN
       PARAMETER (MPI_ERR_UNKNOWN=13)
       INTEGER MPI_ERR_UNSUPPORTED_OPERATION
       PARAMETER (MPI_ERR_UNSUPPORTED_OPERATION=44)
       INTEGER MPI_ERR_QUOTA
       PARAMETER (MPI_ERR_QUOTA=39)
       INTEGER MPI_ERR_AMODE
       PARAMETER (MPI_ERR_AMODE=21)
       INTEGER MPI_ERR_ROOT
       PARAMETER (MPI_ERR_ROOT=7)
       INTEGER MPI_ERR_RANK
       PARAMETER (MPI_ERR_RANK=6)
       INTEGER MPI_ERR_DIMS
       PARAMETER (MPI_ERR_DIMS=11)
       INTEGER MPI_ERR_NO_SUCH_FILE
       PARAMETER (MPI_ERR_NO_SUCH_FILE=37)
       INTEGER MPI_ERR_SERVICE
       PARAMETER (MPI_ERR_SERVICE=41)
       INTEGER MPI_ERR_INTERN
       PARAMETER (MPI_ERR_INTERN=16)
       INTEGER MPI_ERR_IO
       PARAMETER (MPI_ERR_IO=32)
       INTEGER MPI_ERR_ACCESS
       PARAMETER (MPI_ERR_ACCESS=20)
       INTEGER MPI_ERR_NO_SPACE
       PARAMETER (MPI_ERR_NO_SPACE=36)
       INTEGER MPI_ERR_CONVERSION
       PARAMETER (MPI_ERR_CONVERSION=23)
       INTEGER MPI_ERRORS_ARE_FATAL
       PARAMETER (MPI_ERRORS_ARE_FATAL=1409286144)
       INTEGER MPI_ERRORS_RETURN
       PARAMETER (MPI_ERRORS_RETURN=1409286145)
       INTEGER MPI_IDENT
       PARAMETER (MPI_IDENT=0)
       INTEGER MPI_CONGRUENT
       PARAMETER (MPI_CONGRUENT=1)
       INTEGER MPI_SIMILAR
       PARAMETER (MPI_SIMILAR=2)
       INTEGER MPI_UNEQUAL
       PARAMETER (MPI_UNEQUAL=3)
       INTEGER MPI_MAX
       PARAMETER (MPI_MAX=1476395009)
       INTEGER MPI_MIN
       PARAMETER (MPI_MIN=1476395010)
       INTEGER MPI_SUM
       PARAMETER (MPI_SUM=1476395011)
       INTEGER MPI_PROD
       PARAMETER (MPI_PROD=1476395012)
       INTEGER MPI_LAND
       PARAMETER (MPI_LAND=1476395013)
       INTEGER MPI_BAND
       PARAMETER (MPI_BAND=1476395014)
       INTEGER MPI_LOR
       PARAMETER (MPI_LOR=1476395015)
       INTEGER MPI_BOR
       PARAMETER (MPI_BOR=1476395016)
       INTEGER MPI_LXOR
       PARAMETER (MPI_LXOR=1476395017)
       INTEGER MPI_BXOR
       PARAMETER (MPI_BXOR=1476395018)
       INTEGER MPI_MINLOC
       PARAMETER (MPI_MINLOC=1476395019)
       INTEGER MPI_MAXLOC
       PARAMETER (MPI_MAXLOC=1476395020)
       INTEGER MPI_REPLACE
       PARAMETER (MPI_REPLACE=1476395021)
       INTEGER MPI_COMM_WORLD
       PARAMETER (MPI_COMM_WORLD=1140850688)
       INTEGER MPI_COMM_SELF
       PARAMETER (MPI_COMM_SELF=1140850689)
       INTEGER MPI_GROUP_EMPTY
       PARAMETER (MPI_GROUP_EMPTY=1207959552)
       INTEGER MPI_COMM_NULL
       PARAMETER (MPI_COMM_NULL=67108864)
       INTEGER MPI_WIN_NULL
       PARAMETER (MPI_WIN_NULL=536870912)
       INTEGER MPI_FILE_NULL
       PARAMETER (MPI_FILE_NULL=0)
       INTEGER MPI_GROUP_NULL
       PARAMETER (MPI_GROUP_NULL=134217728)
       INTEGER MPI_OP_NULL
       PARAMETER (MPI_OP_NULL=402653184)
       INTEGER MPI_DATATYPE_NULL
       PARAMETER (MPI_DATATYPE_NULL=201326592)
       INTEGER MPI_REQUEST_NULL
       PARAMETER (MPI_REQUEST_NULL=738197504)
       INTEGER MPI_ERRHANDLER_NULL
       PARAMETER (MPI_ERRHANDLER_NULL=335544320)
       INTEGER MPI_INFO_NULL
       PARAMETER (MPI_INFO_NULL=469762048)
       INTEGER MPI_TAG_UB
       PARAMETER (MPI_TAG_UB=1681915906)
       INTEGER MPI_HOST
       PARAMETER (MPI_HOST=1681915908)
       INTEGER MPI_IO
       PARAMETER (MPI_IO=1681915910)
       INTEGER MPI_WTIME_IS_GLOBAL
       PARAMETER (MPI_WTIME_IS_GLOBAL=1681915912)
       INTEGER MPI_UNIVERSE_SIZE
       PARAMETER (MPI_UNIVERSE_SIZE=1681915914)
       INTEGER MPI_LASTUSEDCODE
       PARAMETER (MPI_LASTUSEDCODE=1681915916)
       INTEGER MPI_APPNUM
       PARAMETER (MPI_APPNUM=1681915918)
       INTEGER MPI_WIN_BASE
       PARAMETER (MPI_WIN_BASE=1711276034)
       INTEGER MPI_WIN_SIZE
       PARAMETER (MPI_WIN_SIZE=1711276036)
       INTEGER MPI_WIN_DISP_UNIT
       PARAMETER (MPI_WIN_DISP_UNIT=1711276038)
       INTEGER MPI_MAX_ERROR_STRING
       PARAMETER (MPI_MAX_ERROR_STRING=1023)
       INTEGER MPI_MAX_PORT_NAME
       PARAMETER (MPI_MAX_PORT_NAME=255)
       INTEGER MPI_MAX_OBJECT_NAME
       PARAMETER (MPI_MAX_OBJECT_NAME=127)
       INTEGER MPI_MAX_INFO_KEY
       PARAMETER (MPI_MAX_INFO_KEY=254)
       INTEGER MPI_MAX_INFO_VAL
       PARAMETER (MPI_MAX_INFO_VAL=1023)
       INTEGER MPI_MAX_PROCESSOR_NAME
       PARAMETER (MPI_MAX_PROCESSOR_NAME=128-1)
       INTEGER MPI_MAX_DATAREP_STRING
       PARAMETER (MPI_MAX_DATAREP_STRING=127)
       INTEGER MPI_UNDEFINED, MPI_UNDEFINED_RANK
       PARAMETER (MPI_UNDEFINED=(-32766))
       PARAMETER (MPI_UNDEFINED_RANK=(-32766))
       INTEGER MPI_KEYVAL_INVALID
       PARAMETER (MPI_KEYVAL_INVALID=603979776)
       INTEGER MPI_BSEND_OVERHEAD
       PARAMETER (MPI_BSEND_OVERHEAD=95)
       INTEGER MPI_PROC_NULL
       PARAMETER (MPI_PROC_NULL=-1)
       INTEGER MPI_ANY_SOURCE
       PARAMETER (MPI_ANY_SOURCE=-2)
       INTEGER MPI_ANY_TAG
       PARAMETER (MPI_ANY_TAG=-1)
       INTEGER MPI_ROOT
       PARAMETER (MPI_ROOT=-3)
       INTEGER MPI_GRAPH
       PARAMETER (MPI_GRAPH=1)
       INTEGER MPI_CART
       PARAMETER (MPI_CART=2)
       INTEGER MPI_VERSION
       PARAMETER (MPI_VERSION=2)
       INTEGER MPI_SUBVERSION
       PARAMETER (MPI_SUBVERSION=1)
       INTEGER MPI_LOCK_EXCLUSIVE
       PARAMETER (MPI_LOCK_EXCLUSIVE=234)
       INTEGER MPI_LOCK_SHARED
       PARAMETER (MPI_LOCK_SHARED=235)
       INTEGER MPI_COMPLEX
       PARAMETER (MPI_COMPLEX=1275070494)
       INTEGER MPI_DOUBLE_COMPLEX
       PARAMETER (MPI_DOUBLE_COMPLEX=1275072546)
       INTEGER MPI_LOGICAL
       PARAMETER (MPI_LOGICAL=1275069469)
       INTEGER MPI_REAL
       PARAMETER (MPI_REAL=1275069468)
       INTEGER MPI_DOUBLE_PRECISION
       PARAMETER (MPI_DOUBLE_PRECISION=1275070495)
       INTEGER MPI_INTEGER
       PARAMETER (MPI_INTEGER=1275069467)
       INTEGER MPI_2INTEGER
       PARAMETER (MPI_2INTEGER=1275070496)
       INTEGER MPI_2COMPLEX
       PARAMETER (MPI_2COMPLEX=1275072548)
       INTEGER MPI_2DOUBLE_PRECISION
       PARAMETER (MPI_2DOUBLE_PRECISION=1275072547)
       INTEGER MPI_2REAL
       PARAMETER (MPI_2REAL=1275070497)
       INTEGER MPI_2DOUBLE_COMPLEX
       PARAMETER (MPI_2DOUBLE_COMPLEX=1275076645)
       INTEGER MPI_CHARACTER
       PARAMETER (MPI_CHARACTER=1275068698)
       INTEGER MPI_BYTE
       PARAMETER (MPI_BYTE=1275068685)
       INTEGER MPI_UB
       PARAMETER (MPI_UB=1275068433)
       INTEGER MPI_LB
       PARAMETER (MPI_LB=1275068432)
       INTEGER MPI_PACKED
       PARAMETER (MPI_PACKED=1275068687)
       INTEGER MPI_INTEGER1
       PARAMETER (MPI_INTEGER1=1275068717)
       INTEGER MPI_INTEGER2
       PARAMETER (MPI_INTEGER2=1275068975)
       INTEGER MPI_INTEGER4
       PARAMETER (MPI_INTEGER4=1275069488)
       INTEGER MPI_INTEGER8
       PARAMETER (MPI_INTEGER8=1275070513)
       INTEGER MPI_INTEGER16
       PARAMETER (MPI_INTEGER16=1275072562)
       INTEGER MPI_REAL4
       PARAMETER (MPI_REAL4=1275069479)
       INTEGER MPI_REAL8
       PARAMETER (MPI_REAL8=1275070505)
       INTEGER MPI_REAL16
       PARAMETER (MPI_REAL16=1275072555)
       INTEGER MPI_COMPLEX8
       PARAMETER (MPI_COMPLEX8=1275070504)
       INTEGER MPI_COMPLEX16
       PARAMETER (MPI_COMPLEX16=1275072554)
       INTEGER MPI_COMPLEX32
       PARAMETER (MPI_COMPLEX32=1275076652)
       INTEGER MPI_ADDRESS_KIND, MPI_OFFSET_KIND
       PARAMETER (MPI_ADDRESS_KIND=8)
       PARAMETER (MPI_OFFSET_KIND=8)
       INTEGER MPI_COMBINER_NAMED
       PARAMETER (MPI_COMBINER_NAMED=1)
       INTEGER MPI_COMBINER_DUP
       PARAMETER (MPI_COMBINER_DUP=2)
       INTEGER MPI_COMBINER_CONTIGUOUS
       PARAMETER (MPI_COMBINER_CONTIGUOUS=3)
       INTEGER MPI_COMBINER_VECTOR
       PARAMETER (MPI_COMBINER_VECTOR=4)
       INTEGER MPI_COMBINER_HVECTOR_INTEGER
       PARAMETER (MPI_COMBINER_HVECTOR_INTEGER=5)
       INTEGER MPI_COMBINER_HVECTOR
       PARAMETER (MPI_COMBINER_HVECTOR=6)
       INTEGER MPI_COMBINER_INDEXED
       PARAMETER (MPI_COMBINER_INDEXED=7)
       INTEGER MPI_COMBINER_HINDEXED_INTEGER
       PARAMETER (MPI_COMBINER_HINDEXED_INTEGER=8)
       INTEGER MPI_COMBINER_HINDEXED
       PARAMETER (MPI_COMBINER_HINDEXED=9)
       INTEGER MPI_COMBINER_INDEXED_BLOCK
       PARAMETER (MPI_COMBINER_INDEXED_BLOCK=10)
       INTEGER MPI_COMBINER_STRUCT_INTEGER
       PARAMETER (MPI_COMBINER_STRUCT_INTEGER=11)
       INTEGER MPI_COMBINER_STRUCT
       PARAMETER (MPI_COMBINER_STRUCT=12)
       INTEGER MPI_COMBINER_SUBARRAY
       PARAMETER (MPI_COMBINER_SUBARRAY=13)
       INTEGER MPI_COMBINER_DARRAY
       PARAMETER (MPI_COMBINER_DARRAY=14)
       INTEGER MPI_COMBINER_F90_REAL
       PARAMETER (MPI_COMBINER_F90_REAL=15)
       INTEGER MPI_COMBINER_F90_COMPLEX
       PARAMETER (MPI_COMBINER_F90_COMPLEX=16)
       INTEGER MPI_COMBINER_F90_INTEGER
       PARAMETER (MPI_COMBINER_F90_INTEGER=17)
       INTEGER MPI_COMBINER_RESIZED
       PARAMETER (MPI_COMBINER_RESIZED=18)
       INTEGER MPI_TYPECLASS_REAL
       PARAMETER (MPI_TYPECLASS_REAL=1)
       INTEGER MPI_TYPECLASS_INTEGER
       PARAMETER (MPI_TYPECLASS_INTEGER=2)
       INTEGER MPI_TYPECLASS_COMPLEX
       PARAMETER (MPI_TYPECLASS_COMPLEX=3)
       INTEGER MPI_MODE_NOCHECK
       PARAMETER (MPI_MODE_NOCHECK=1024)
       INTEGER MPI_MODE_NOSTORE
       PARAMETER (MPI_MODE_NOSTORE=2048)
       INTEGER MPI_MODE_NOPUT
       PARAMETER (MPI_MODE_NOPUT=4096)
       INTEGER MPI_MODE_NOPRECEDE
       PARAMETER (MPI_MODE_NOPRECEDE=8192)
       INTEGER MPI_MODE_NOSUCCEED
       PARAMETER (MPI_MODE_NOSUCCEED=16384)
       INTEGER MPI_THREAD_SINGLE
       PARAMETER (MPI_THREAD_SINGLE=0)
       INTEGER MPI_THREAD_FUNNELED
       PARAMETER (MPI_THREAD_FUNNELED=1)
       INTEGER MPI_THREAD_SERIALIZED
       PARAMETER (MPI_THREAD_SERIALIZED=2)
       INTEGER MPI_THREAD_MULTIPLE
       PARAMETER (MPI_THREAD_MULTIPLE=3)
       INTEGER MPI_MODE_RDONLY
       PARAMETER (MPI_MODE_RDONLY=2)
       INTEGER MPI_MODE_RDWR
       PARAMETER (MPI_MODE_RDWR=8)
       INTEGER MPI_MODE_WRONLY
       PARAMETER (MPI_MODE_WRONLY=4)
       INTEGER MPI_MODE_DELETE_ON_CLOSE
       PARAMETER (MPI_MODE_DELETE_ON_CLOSE=16)
       INTEGER MPI_MODE_UNIQUE_OPEN
       PARAMETER (MPI_MODE_UNIQUE_OPEN=32)
       INTEGER MPI_MODE_CREATE
       PARAMETER (MPI_MODE_CREATE=1)
       INTEGER MPI_MODE_EXCL
       PARAMETER (MPI_MODE_EXCL=64)
       INTEGER MPI_MODE_APPEND
       PARAMETER (MPI_MODE_APPEND=128)
       INTEGER MPI_MODE_SEQUENTIAL
       PARAMETER (MPI_MODE_SEQUENTIAL=256)
       INTEGER MPI_SEEK_SET
       PARAMETER (MPI_SEEK_SET=600)
       INTEGER MPI_SEEK_CUR
       PARAMETER (MPI_SEEK_CUR=602)
       INTEGER MPI_SEEK_END
       PARAMETER (MPI_SEEK_END=604)
       INTEGER MPI_ORDER_C
       PARAMETER (MPI_ORDER_C=56)
       INTEGER MPI_ORDER_FORTRAN
       PARAMETER (MPI_ORDER_FORTRAN=57)
       INTEGER MPI_DISTRIBUTE_BLOCK
       PARAMETER (MPI_DISTRIBUTE_BLOCK=121)
       INTEGER MPI_DISTRIBUTE_CYCLIC
       PARAMETER (MPI_DISTRIBUTE_CYCLIC=122)
       INTEGER MPI_DISTRIBUTE_NONE
       PARAMETER (MPI_DISTRIBUTE_NONE=123)
       INTEGER MPI_DISTRIBUTE_DFLT_DARG
       PARAMETER (MPI_DISTRIBUTE_DFLT_DARG=-49767)
       INTEGER (KIND=8) MPI_DISPLACEMENT_CURRENT
       PARAMETER (MPI_DISPLACEMENT_CURRENT=-54278278)
       INTEGER MPI_BOTTOM, MPI_IN_PLACE
!DEC$ ATTRIBUTES DLLIMPORT::/MPIPRIV1/
!DEC$ ATTRIBUTES DLLIMPORT::/MPIPRIV2/
!DEC$ ATTRIBUTES DLLIMPORT::/MPIPRIVC/

       COMMON /MPIPRIV1/ MPI_BOTTOM, MPI_IN_PLACE, MPI_STATUS_IGNORE

       COMMON /MPIPRIV2/ MPI_STATUSES_IGNORE, MPI_ERRCODES_IGNORE
       SAVE /MPIPRIV1/,/MPIPRIV2/

       COMMON /MPIPRIVC/ MPI_ARGVS_NULL, MPI_ARGV_NULL
       SAVE   /MPIPRIVC/

MPI2

MPI2がでて、Fortran90でも書けるようになったようなので、しばらくぶりにMPIいじってみました。
（しかし64Bit版には相変わらずINCLUDEファイルしかない・・・）*1

Gropp et al. "Using MPI" の最初のサンプルをより Fortran90 風に書き直し。

PROGRAM test
USE mpi
IMPLICIT NONE
INTEGER, PARAMETER :: kd = SELECTED_REAL_KIND(13)    ! DBLE
REAL(kd), PARAMETER :: PI25DT = 3.141592653589793238462643_kd
REAL(kd) :: pi_mine, pi, h, sum, x
INTEGER :: n, myid, numprocs, i, ierr
CALL MPI_INIT(ierr)
CALL MPI_COMM_RANK(MPI_COMM_WORLD, myid    , ierr)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD, numprocs, ierr)

DO
 IF (myid == 0) THEN
  PRINT *, 'Enter the number of intervals: (0 quits) '
  READ  *, n 
 END IF

 CALL MPI_BCAST(n, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)

 IF (n <= 0) EXIT
 h = 1.0_kd / n
 sum = 0.0_kd
 DO i = myid + 1, n, numprocs
  x = h * (REAL(i, kd) - 0.5_kd)
  sum = sum + f(x)
 END DO
 pi_mine = h * sum
 
 CALL MPI_REDUCE(pi_mine, pi, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, ierr)
 
 IF (myid == 0) PRINT *, 'pi is ', pi, ' Error is', ABS(pi - PI25DT)
END DO 

CALL MPI_FINALIZE(ierr)
STOP
CONTAINS
!------------------------------------
REAL(kd) FUNCTION f(a)
REAL(kd), INTENT(IN) :: a
f = 4.0_kd / (1.0_kd + a * a)
RETURN
END FUNCTION f
!------------------------------------
END PROGRAM test

実行結果

備忘のメモ。

• Path　C:\Program Files\MPICH2\bin\

• Project->Properties->Linker->Input->Additional Files => fmpich2.lib
• Tools->Option->Intel Visual Fortran->Compiler->Library=>C:\Program Files\MPICH2\lib
• Tools->Option->Intel Visual Fortran->Compiler->Include=>C:\Program Files\MPICH2\include

• Vistaでは手動で smpd -install で Windows のサービスを起動する必要あり？
• VistaではDOS窓を管理者権限で開く必要あり。

• MPICH2のインストール
  • http://ums.futene.net/wiki/Paralell/4D5049434832206F6E2057696E646F7773204C6F63616C.html
• このサイトのディレクトリ入力例はC:\の\が抜けているのでコピペ時に注意。

*1:自分でソースからコンパイルすれば可。