Subroutine to receive the convergence status from the previous processor
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(pf_pfasst_t), | intent(inout) | :: | pf | |||
integer, | intent(in) | :: | tag | |||
integer, | intent(in), | optional | :: | direction |
subroutine pf_recv_status(pf, tag, direction)
type(pf_pfasst_t), intent(inout) :: pf
integer, intent(in) :: tag
integer, optional, intent(in) :: direction
integer :: dir
integer :: ierror, istatus
dir = 1 ! default 1: send forward; set to 2 for send backwards
if(present(direction)) dir = direction
! Return if this is the first processor
if (pf%rank == 0 .and. dir == 1) return
if (pf%rank == pf%comm%nproc-1 .and. dir == 2) return
if (pf%debug) print*, 'DEBUG --',pf%rank, 'begin recv_status with pstatus=',pf%state%pstatus, ' tag=',tag
ierror = 0
if (dir == 1) then
call pf%comm%recv_status(pf, tag, istatus, ierror, dir)
if (pf%debug) print *, 'DEBUG --', pf%rank, 'status recvd = ', istatus
if (ierror .eq. 0) pf%state%pstatus = istatus
elseif (dir == 2) then
if (pf%debug) print*, pf%rank, 'my status = ', pf%state%status
if (pf%debug) print*, pf%rank, 'is receiving status backwards with tag ', tag
call pf%comm%recv_status(pf, tag, istatus, ierror, dir)
if (pf%debug) print *, pf%rank, 'status recvd = ', istatus
if (ierror .eq. 0) pf%state%pstatus = istatus
else
print *, pf%rank, 'warning: bad dir in recv_status', dir
stop "pf_parallel_oc:pf_recv_status"
end if
if (pf%debug) print*, 'DEBUG --',pf%rank, 'end recv_statuswith pstatus=',pf%state%pstatus,'tag=',tag
if (ierror .ne. 0) then
print *, pf%rank, 'warning: error during recv_status', ierror
stop "pf_parallel_oc:pf_recv_status"
endif
end subroutine pf_recv_status