Commit 896e9d0d authored by Roy Fabrice's avatar Roy Fabrice
Browse files

always init io_process in build_mpi_process_cart

the same should be done in build_my_process_grid
parent 440e3dcb
......@@ -91,34 +91,29 @@ contains
call mpi_cart_shift(mpi_process%comm%name, 2, 1, mpi_process%neighbours(5), &
mpi_process%neighbours(6), mpierr)
if(parameters%gatherwrite_factor > 1) then
#ifdef DEBUG
if(mpi_process%rank == 0) then
write(ERROR_UNIT,'(a)') '*** Creating specific communicator for gathered cube output ***'
end if
if(mpi_process%rank == 0) then
write(ERROR_UNIT,'(a)') '*** Creating specific communicator for gathered cube output ***'
end if
#endif
allocate(mpi_process%write_process, stat=alloc_stat, errmsg=error_message)
if(alloc_stat /= 0) then
call Allocate_error('mpi_process%write_process',ROUTINE_NAME, error_message, alloc_stat, mpi_process%rank)
end if
mpi_process%write_process => Init_io_process(mpi_process, parameters%gatherwrite_factor)
allocate(mpi_process%write_process, stat=alloc_stat, errmsg=error_message)
if(alloc_stat /= 0) then
call Allocate_error('mpi_process%write_process',ROUTINE_NAME, error_message, alloc_stat, mpi_process%rank)
end if
mpi_process%write_process => Init_io_process(mpi_process, parameters%gatherwrite_factor)
if(parameters%gatherread_factor > 1) then
#ifdef DEBUG
if(mpi_process%rank == 0) then
write(ERROR_UNIT,'(a)') '*** Creating specific communicator for gathered cube input ***'
end if
if(mpi_process%rank == 0) then
write(ERROR_UNIT,'(a)') '*** Creating specific communicator for gathered cube input ***'
end if
#endif
allocate(mpi_process%read_process, stat=alloc_stat, errmsg=error_message)
if(alloc_stat /= 0) then
call Allocate_error('mpi_process%read_process',ROUTINE_NAME, error_message, alloc_stat, mpi_process%rank)
end if
mpi_process%read_process => Init_io_process(mpi_process, parameters%gatherread_factor)
allocate(mpi_process%read_process, stat=alloc_stat, errmsg=error_message)
if(alloc_stat /= 0) then
call Allocate_error('mpi_process%read_process',ROUTINE_NAME, error_message, alloc_stat, mpi_process%rank)
end if
mpi_process%read_process => Init_io_process(mpi_process, parameters%gatherread_factor)
call timer%Inc_Comm()
#ifdef DEBUG
......@@ -225,18 +220,35 @@ contains
character(ERR_MSG_LEN) :: error_message
type(mpi_process_t), pointer :: io_process
integer :: mpierr
character(*), parameter :: ROUTINE_NAME = 'Init_io_process'
#ifdef DEBUG
write(ERROR_UNIT,'(a,i0)') ROUTINE_NAME//' begins on process', process%rank
#endif
allocate(io_process, stat=alloc_stat, errmsg=error_message)
if(alloc_stat /= 0) then
call Allocate_error('io_process','Init_io_process', error_message, alloc_stat, process%rank)
end if
io_process%color = process%coords(1)/factor + &
(process%coords(2)/factor) * (process%comm%dims(1)/factor) + &
(process%coords(3)/factor) * (process%comm%dims(1)/factor) * (process%comm%dims(1)/factor)
call mpi_comm_split(process%comm%name, io_process%color, process%rank, io_process%comm%name, mpierr)
call mpi_comm_rank(io_process%comm%name, io_process%rank, mpierr)
call mpi_comm_size(io_process%comm%name, io_process%comm%size, mpierr)
end if
if(factor == 1) then
io_process%rank = process%rank
io_process%comm%name = process%comm%name
io_process%comm%size = process%comm%size
io_process%color = process%rank
else if(factor > 1) then
io_process%color = process%coords(1)/factor + &
(process%coords(2)/factor) * (process%comm%dims(1)/factor) + &
(process%coords(3)/factor) * (process%comm%dims(1)/factor) * (process%comm%dims(1)/factor)
call mpi_comm_split(process%comm%name, io_process%color, process%rank, io_process%comm%name, mpierr)
call mpi_comm_rank(io_process%comm%name, io_process%rank, mpierr)
call mpi_comm_size(io_process%comm%name, io_process%comm%size, mpierr)
end if
#ifdef DEBUG
write(ERROR_UNIT,'(a,i0)') ROUTINE_NAME//' ends on process', process%rank
#endif
end function Init_io_process
end module mpi_communicator_m
\ No newline at end of file
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment