fortran - Wait until a subroutine is not used by other process -

i have mpi-parallelized code loops through n persons, , each 1 calls subroutines calculations , after inside loop calls post-processing subroutine.

in post-processing subroutine, write output want in following way:

person_number var1 var2  

let's every person belongs different rank. problem when write file person1, maybe process of rank3 includes person3 variables executing post-processing subroutine, overwrites data of person1.

what want find way, pause other processes before calling post-processing subroutine, , once subroutine not used previous rank, run next rank , on.

this sketch of code:

call mpi_init(ierr)  = 1, npersons  call subroutine1(arg1,arg2,arg3)  ! call if post_process not executed other process ! otherwise wait until ends , call  call post_process(i, var1, var2)  enddo  call mpi_finalize(ierr)   subroutine post_process(i, var1, var2) integer:: real*8:: var1, var2 write(111,*) i, var1, var2 end subroutine post_process 

reading comment: " also, wondering if example process 3 faster process 2, if can use same way rank 1 finishes routine notify rank 3 run routine , rank 3 notify rank 2. there automatic way of this? know rank waits before post-processing step longer?"

this can addressed letting i/o performed on process irank==0 and using buffered sends.

in case don't want let processes wait, no barriers here, want let them dispatch result it's ready, , continue calculating. when it's time process 0, receive buffered data , write them, write own data. can try use standard mpi_send (it's buffered prefixed size), best way use mpi_bsend , attach correctly sized buffer mpi_buffer_attach(). this:

subroutine post_process(i, var1, var2, irank) integer:: i, irank real*8:: var1, var2 integer:: ir real*8:: var1r, var2r character buffer(100) integer ipos boolean flag  if (irank .gt. 0)   ipos = 0   call mpi_pack(i, 1, mpi_integer, buffer, 100, ipos, mpi_comm_world, ierr)   call mpi_pack(var1, 1, mpi_real8, buffer, 100, ipos, mpi_comm_world, ierr)   call mpi_pack(var2, 1, mpi_real8, buffer, 100, ipos, mpi_comm_world, ierr)   call mpi_bsend( buffer, ipos, mpi_packed, 0, 0, mpi_comm_world, ierr)  else       call mpi_iprobe(mpi_any_source, 0, mpi_comm_world, flag, mpi_status_ignore, ierr)     if (flag .eq. false) exit     call mpi_recv(buffer, 100, mpi_packed, mpi_any_source, 0, mpi_comm_world, mpi_status_ignore, ierr)     ipos = 0     call mpi_unpack(buffer, 100, ipos, ir, 1, mpi_integer, mpi_comm_world, ierr)     call mpi_unpack(buffer, 100, ipos, var1r, 1, mpi_real8, mpi_comm_world, ierr)     call mpi_unpack(buffer, 100, ipos, var2r, 1, mpi_real8, mpi_comm_world, ierr)     write(111,*) ir, var1r, var2r         enddo   write(111,*) i, var1, var2 end if end subroutine post_process