pf_send_status Subroutine

  1. pf_comm.f90
  2. pf_mod_comm
  3. pf_send_status

public subroutine pf_send_status(pf, tag, direction)

Subroutine to send this processor's convergence status to the next processor

Arguments

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

Called by

proc~~pf_send_status~~CalledByGraph proc~pf_send_status pf_send_status proc~pf_check_convergence_oc pf_check_convergence_oc proc~pf_check_convergence_oc->proc~pf_send_status proc~pf_check_convergence_block pf_check_convergence_block proc~pf_check_convergence_block->proc~pf_send_status proc~pf_block_run pf_block_run proc~pf_block_run->proc~pf_check_convergence_block proc~pf_pfasst_block_oc pf_pfasst_block_oc proc~pf_pfasst_block_oc->proc~pf_check_convergence_oc proc~pf_pfasst_run pf_pfasst_run proc~pf_pfasst_run->proc~pf_block_run

Contents

Source Code

pf_send_status

Source Code

  subroutine pf_send_status(pf, tag, direction)
    type(pf_pfasst_t), intent(inout) :: pf
    integer,           intent(in)    :: tag
    integer, optional, intent(in)    :: direction
    integer ::  dir
    integer ::  istatus
    integer ::  ierror
    
    dir = 1 ! default 1: send forward; set to 2 for send backwards
    if(present(direction)) dir = direction

    if (pf%rank == 0 .and. dir == 2) return
    if (pf%rank == pf%comm%nproc-1 .and. dir == 1) return

    ierror = 0
    istatus = pf%state%status
    if (dir == 1) then
       if (pf%debug) print*, 'DEBUG --',pf%rank, 'begins send_status with status', istatus, 'with tag =', tag 
       call pf%comm%send_status(pf, tag, istatus, ierror, dir)
       if (pf%debug) print*, 'DEBUG --',pf%rank, 'ends send_status' 
    elseif (dir == 2) then
       if (pf%debug) print*, 'DEBUG --',pf%rank, 'begins send_status with status', istatus, 'backwards with tag =', tag 
       call pf%comm%send_status(pf, tag, istatus, ierror, dir)
       if (pf%debug) print*, 'DEBUG --',pf%rank, 'ends send_status'
    else
       print *, pf%rank, 'warning: bad dir during send_status', dir
      stop "pf_parallel:pf_send_status"
    end if
    
    if (ierror /= 0) then
      print *, pf%rank, 'warning: error during send_status', ierror
      stop "pf_parallel:pf_send_status"
    endif
    
  end subroutine pf_send_status