pf_recv_status Subroutine

public subroutine pf_recv_status(pf, tag, direction)

Subroutine to receive the convergence status from the previous processor

Arguments

Type IntentOptional AttributesName
type(pf_pfasst_t), intent(inout) :: pf
integer, intent(in) :: tag
integer, intent(in), optional :: direction

Contents

Source Code


Source Code

  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