MPIを用いたプログラムでパラメータを外部ファイルから入力するためのサンプルプログラム
Fortranプログラムにおいて、d:id:rigarash:20100201:1264984235で書いたように、namelistからの入力は強力なのですが、MPI並列化のプログラムでは、コマンドラインなどにアクセスできるのは1ノードだけだったりするので、ポータブルに読み込むにはもう少し注意が必要です。少なくともIntel Fortran 11.0 + Intel MPI 3.1.0 と gfortran 4.4.3 + OpenMPI 1.3.3 (Debian GNU/Linux (sid))でうまく動き、できるだけ標準(Fortran2003含む)に準拠したサンプルを書いてみました。
program main implicit none include "mpif.h" integer :: a,b,c integer :: res integer, dimension(:), allocatable :: resv integer :: clcount character(len=256) :: arg integer :: arglen integer :: ioerr,mpierr integer :: i,j integer :: rank,np namelist /param/ a,b,c a=1 b=2 c=3 call MPI_Init(mpierr) call MPI_Comm_rank(MPI_COMM_WORLD,rank,mpierr) call MPI_Comm_size(MPI_COMM_WORLD,np,mpierr) if (rank == 0) then clcount=command_argument_count() endif call MPI_Bcast(clcount,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) if (clcount == 0) then call stop_program(rank,np,"*** no input file specified. ***") endif if (rank == 0) then allocate(resv(np),stat=ioerr) endif call MPI_Bcast(ioerr,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) if (ioerr > 0) then call stop_program(rank,np,"*** result vector allocation fails ***") endif do i=1,clcount if (rank == 0) then call get_command_argument(i,arg,arglen,ioerr) endif call MPI_Bcast(ioerr,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) if (ioerr > 0) then call stop_program(rank,np,"*** input file name retrieval fails ***") elseif (ioerr == -1) then call stop_program(rank,np,"*** input file name too long ***") endif if (rank == 0) then open(unit=100,file=arg,iostat=ioerr) endif call MPI_Bcast(ioerr,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) if (ioerr > 0) then call stop_program(rank,np,"*** Cannot open input file ***") endif if (rank == 0) then read(unit=100,nml=param,iostat=ioerr) if (ioerr < 0) then print*,"*** parameter reading FAILED. Use default value instead ***" endif close(unit=100) write(unit=6,nml=param) endif call MPI_Bcast(a,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) call MPI_Bcast(b,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) call MPI_Bcast(c,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) res = a + b + c call MPI_gather(res,1,MPI_INTEGER,resv,1,MPI_INTEGER,0,MPI_COMM_WORLD,mpierr) if (rank == 0) then do j=1,np write(6,*), j,resv(j) enddo endif deallocate(resv,stat=ioerr) enddo call stop_program(rank,np,"") end program main subroutine stop_program(rank,np,text) implicit none include "mpif.h" integer :: rank,np integer :: mpierr character(*) :: text if (rank == 0) then write(6,*), trim(text) endif call MPI_finalize(mpierr) stop end subroutine stop_program