2.4 Динамическая параллельная программа с использованием mpi

Теперь займемся динамическим порождением процессов. Стандарт MPI-2 предусматривает механизмы порождения новых ветвей из уже запущенных в процессе выполнения параллельные программы. В MPI-2 это происходит путем запуска файлов программ (аналогично функциям exec() стандарта POSIX.1) с помощью функции MPI_COMM_SPAWN() или MPI_COMM_SPAWN_MULTIPLE(), первая запускает заданное количество копий одной программы, вторая может запускать несколько разных программ.

Запущенные с помощью MPI_COMM_SPAWN процессы не принадлежат группе родителя (MPI_COMM_WORLD) и выполняются в отдельной среде. Порожденные процессы имеют свои ранги которые могут совпадать с рангами группы, в которой выполнялся родительский процесс. Обмен сообщениями между процессами родительской и дочерней групп происходит с использованием так называемого интеркоммуникатора, который возвращается процессу-родителю функцией MPI_COMM_SPAWN(). Дочерние процессы могут получить интеркоммуникатор группы родителя с помощью функции MPI_COMM_GET_PARENT(). Значение интеркоммуникатора используется функциями обмена сообщениями MPI_SEND(), MPI_RECV() и другими.

Приведем пример динамической MPI-программы на языке FORTRAN77. Здесь один родительский процесс порождает три дочерних, затем один дочерний процесс посылает остальным дочерним процессам широковещательное сообщение(MPI_BCAST()), после чего один дочерний процесс посылает сообщение родителю (MPI_SEND()) и принимает от него ответ (MPI_RECV()). Дочерние процессы запускаются родительским с параметром командной строки "--slave", текст программы [http://mechanoid.narod.ru/parallel/mpi2/spawn.f].

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* $Id: spawn.f,v 1.7 2006/03/04 16:56:04 mechanoid Exp mechanoid $

*

*

* dynamical parallel procceses demo with MPICH2

*

*

* OS : FreeBSD 5.3

* COMPILER : mpif77 for MPICH2 v.1.0.3

* gcc version 3.4.2 [FreeBSD]

* GNU ld version 2.15 [FreeBSD]

*

* AUTHOR : Evgeny S. Borisov

*

* Glushkov Institute of Cybernetics

* National Academy of Sciences of Ukraine

*

* http://www.mechanoid.kiev.ua

* e-mail : par@mechanoid.kiev.ua

*

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

PROGRAM spawn

implicit none

include 'mpif.h'

* количество дочерних процессов

integer PROCESS

parameter(PROCESS=3)

logical cmd_arg_parse,master

integer iam,nprocs,ierr,namelen

integer icomm,errcodes(PROCESS),i

integer slave_rank, master_rank

integer stat(MPI_STATUS_SIZE)

character*50 proc_name

character*20 argv(2)

character*30 msg

* проверка аргументов командной строки

if(cmd_arg_parse(master)) then

stop

endif

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* инициализация MPI, сбор технической информации

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

call MPI_INIT(ierr)

call MPI_COMM_RANK(MPI_COMM_WORLD, iam, ierr)

call MPI_GET_PROCESSOR_NAME(proc_name,namelen,ierr);

proc_name(namelen+1:namelen+1)='\0'

if(master) then

write(*,3000),'master',iam,proc_name

else

write(*,3000),'slave',iam,proc_name

endif

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* запуск дочерних процессов

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

IF(master) THEN

* главный процесс запускает дочерние

argv(1) = '--slave'

argv(2) = ' '

call MPI_COMM_SPAWN('./spawn\0',

+ argv,

+ PROCESS,

+ MPI_INFO_NULL,

+ 0,

+ MPI_COMM_SELF,

+ icomm,

+ errcodes,

+ ierr)

if((ierr.ne.MPI_SUCCESS).or.(icomm.eq.MPI_COMM_NULL))then

write(*,*)'MPI_COMM_SPAWN error:',ierr

goto 100

endif

* проверка состояния дочерних процессов

do i=1,PROCESS

if(errcodes(i).ne.MPI_SUCCESS) then

write(*,*)iam,': spawn error =',ierr,' for process ',i

endif

enddo

ELSE

* дочерний процесс получает коммуникатор родителя

call MPI_COMM_GET_PARENT(icomm,ierr)

if((ierr.ne.MPI_SUCCESS).or.(icomm.eq.MPI_COMM_NULL))then

write(*,*)'MPI_COMM_GET_PARENT error:',ierr

goto 100

endif

ENDIF

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* обмен сообщениями между родительским дочерним процессами

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* ранг родительского процесса в своей группе, участвующего в коммуникации

master_rank=0

* ранг дочернего процесса в своей группе, участвующего в коммуникации

slave_rank=2

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* обмен между дочерними процессами

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* формируем сообщение

if( (.not.master).and.(iam.eq.slave_rank)) then

write (msg,4000),'slave', iam

else

msg='---\0'

endif

* процесс slave_rank посылает сообщение всей своей группе

if(.not. master) then

call MPI_BCAST(msg,len(msg),MPI_CHARACTER,

+ slave_rank,MPI_COMM_WORLD,ierr)

write(*,1000),'slave',iam,proc_name, msg

endif

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* посылка от родительского дочернему процессу

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* формируем сообщение

if( master .and. (iam.eq.master_rank)) then

write (msg,2000),'master', iam

else

msg='---\0'

endif

* родительский процесс отсылает сообщение

if( master.and.(master_rank.eq.iam) ) then

call MPI_SEND(msg,len(msg),MPI_CHARACTER,

+ slave_rank,0,icomm,ierr)

endif

* дочерний процесс принимает сообщение

if((.not.master).and.(iam.eq.slave_rank)) then

call MPI_RECV(msg,len(msg),MPI_CHARACTER,

+ master_rank,0,icomm,stat,ierr)

write(*,1000),'slave',iam,proc_name, msg

endif

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* посылка от дочернего родительскому процессу

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* формируем сообщение

if( (.not.master) .and. (iam.eq.slave_rank)) then

write (msg,2000),'slave', iam

else

msg='---'

endif

* дочерний процесс отсылает сообщение

if((.not.master).and.(iam.eq.slave_rank)) then

call MPI_SEND(msg,len(msg),MPI_CHARACTER,

+ master_rank,0,icomm,ierr)

endif

* родительский процесс принимает сообщение

if( master.and.(master_rank.eq.iam) ) then

call MPI_RECV(msg,len(msg),MPI_CHARACTER,

+ slave_rank,0,icomm,stat,ierr)

write(*,1000),'master',iam,proc_name, msg

endif

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* завершение работы

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

call MPI_COMM_DISCONNECT(icomm, ierr)

100 continue

call MPI_FINALIZE(ierr)

stop

1000 format(a7,i2,' on ',a15,' : ',a30)

3000 format(a7,i2,' on ',a15,' : start')

2000 format('message from', a7, i2)

4000 format('broadcast from', a7, i2)

END

* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

* проверка аргументов командной строки

* если командная строка допустима -- функция возвращает .false.

* если командная строка содержит аргумент "--slave"

* то переменная master устанавливается в .false. иначе в .true.

function cmd_arg_parse(master)

logical cmd_arg_parse

logical master

integer npar

character*100 arg

cmd_arg_parse=.true.

master=.true.

* количество аргументов

npar=iargc()

if(npar.eq.0) then

* без параметров -- процесс master

cmd_arg_parse=.false.

return

endif

if(npar .ne. 1) then

* неправильное количество параметров

write (*,*) 'usage: getarg [--slave]'

return

endif

* получение значения аргумента номер 1

call getarg(1,arg)

if(arg.ne.'--slave')then

write (*,*) 'unknow option:',arg

write (*,*) 'usage: getarg [--slave]'

return

endif

* процесс slave

master=.false.

cmd_arg_parse=.false.

return

end

Результат работы программы:

$ mpiexec -n 1 ./spawn

master 0 on node2.home.net : start

slave 1 on node2.home.net : start

slave 0 on node1.home.net : start

slave 2 on node1.home.net : start

slave 1 on node2.home.net : broadcast from slave 2

slave 0 on node1.home.net : broadcast from slave 2

slave 2 on node1.home.net : broadcast from slave 2

master 0 on node2.home.net : message from slave 2

slave 2 on node1.home.net : message from master 0