subroutine ArrDescrCreateWriterComm(arrdes, full_comm, num_writers, rc)
type(ArrDescr), intent(inout) :: arrdes
integer, intent(in) :: full_comm
integer, intent(in) :: num_writers
integer, optional, intent(out) :: rc
integer :: status, nx, ny, color, ny_by_writers, myid, j, writer_rank
nx = size(arrdes%i1)
ny = size(arrdes%j1)
_ASSERT(num_writers <= ny,'num writers must be less or equal to than NY')
_ASSERT(mod(ny,num_writers)==0,'num writerss must evenly divide NY')
call mpi_comm_rank(full_comm,myid, status)
_VERIFY(status)
color = arrdes%NX0
call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Ycomm, status)
_VERIFY(status)
color = arrdes%NY0
call MPI_COMM_SPLIT(full_comm, color, MYID, arrdes%Xcomm, status)
_VERIFY(status)
ny_by_writers = ny/num_writers
if (mod(myid,nx*ny/num_writers) == 0) then
color = 0
else
color = MPI_UNDEFINED
endif
call MPI_COMM_SPLIT(full_comm, color, myid, arrdes%writers_comm, status)
_VERIFY(status)
if (num_writers==ny) then
arrdes%IOgathercomm = arrdes%Xcomm
else
j = arrdes%NY0 - mod(arrdes%NY0-1,ny_by_writers)
call MPI_COMM_SPLIT(full_comm, j, myid, arrdes%IOgathercomm, status)
_VERIFY(status)
endif
if (arrdes%writers_comm /= MPI_COMM_NULL) then
call mpi_comm_rank(arrdes%writers_comm,writer_rank,status)
_VERIFY(STATUS)
end if
call MPI_BCast(writer_rank,1,MPI_INTEGER,0,arrdes%iogathercomm,status)
_VERIFY(STATUS)
arrdes%writer_id = writer_rank
_RETURN(_SUCCESS)
end subroutine ArrDescrCreateWriterComm