pf_check_convergence_oc Subroutine

  1. pf_parallel_oc.f90
  2. pf_mod_parallel_oc
  3. pf_check_convergence_oc

public subroutine pf_check_convergence_oc(pf, send_tag, flags)

Test residuals to determine if the current processor has converged, adapted to optimal control. Can probably be removed, when pf_pfasst_block_oc is changed to use pf_check_convergence of pf_check_convergence_old.

Note that if the previous processor hasn't converged yet (pstatus), the current processor hasn't converged yet either, regardless of the residual.

Check to see if tolerances are met

Until I hear the previous processor is done, recieve it's status

Check to see if I am converged Assign status and send it forward ! old code below

Arguments

Type IntentOptional AttributesName
type(pf_pfasst_t), intent(inout) :: pf
integer, intent(in) :: send_tag
integer, intent(in), optional :: flags

Calls

proc~~pf_check_convergence_oc~~CallsGraph proc~pf_check_convergence_oc pf_check_convergence_oc proc~call_hooks call_hooks proc~pf_check_convergence_oc->proc~call_hooks proc~pf_send_status pf_send_status proc~pf_check_convergence_oc->proc~pf_send_status proc~pf_check_residual_oc pf_check_residual_oc proc~pf_check_convergence_oc->proc~pf_check_residual_oc proc~start_timer start_timer proc~call_hooks->proc~start_timer proc~end_timer end_timer proc~call_hooks->proc~end_timer

Called by

proc~~pf_check_convergence_oc~~CalledByGraph proc~pf_check_convergence_oc pf_check_convergence_oc proc~pf_pfasst_block_oc pf_pfasst_block_oc proc~pf_pfasst_block_oc->proc~pf_check_convergence_oc

Contents

Source Code

pf_check_convergence_oc

Source Code

  subroutine pf_check_convergence_oc(pf, send_tag, flags)
    type(pf_pfasst_t), intent(inout) :: pf
    integer,           intent(in)    :: send_tag
!     real(pfdp),        intent(inout) :: residual
!     integer,           intent(in)    :: k
!     logical,           intent(out)   :: converged   !!  True if this processor is done
    integer, optional, intent(in)    :: flags
!     real(pfdp)     :: residual1
    integer :: dir, which
    logical :: residual_converged, converged
    
    converged = .false.

    
    ! shortcut for fixed block mode
    if (pf%abs_res_tol == 0 .and. pf%rel_res_tol == 0) then
       pf%state%pstatus = PF_STATUS_ITERATING
       pf%state%status  = PF_STATUS_ITERATING
       return
    end if
    
    ! in first sweep: always continue
    if (pf%state%iter == 1) then
       pf%state%pstatus = PF_STATUS_ITERATING
       pf%state%status  = PF_STATUS_ITERATING
       return
    end if
    
    which = 1
    if (present(flags)) which = flags
    ! send forward by default, even if sweeping on both components; send backwards if sweeping on p only
    dir = 1
    if(which == 2) dir = 2

    call call_hooks(pf, 1, PF_PRE_CONVERGENCE)
    
    !> Check to see if tolerances are met
    call pf_check_residual_oc(pf, residual_converged)
    
    !>  Until I hear the previous processor is done, recieve it's status
    if (pf%state%pstatus /= PF_STATUS_CONVERGED) call pf_recv_status(pf, send_tag, dir)

    !>  Check to see if I am converged
    converged = .false.
    if (residual_converged) then
       if (pf%rank == 0 .and. dir==1) then
          converged = .true.
       elseif (pf%rank == pf%comm%nproc-1 .and. dir==2) then
          converged = .true.
       else  !  I am not the first/last processor, so I need to check the previous one
          if (pf%state%pstatus == PF_STATUS_CONVERGED) converged = .true.
       end if
    end if ! (residual_converged)


    !> Assign status and send it forward
    if (converged) then
       if (pf%state%status == PF_STATUS_ITERATING) then
          !  If I am converged for the first time
          !  then flip my flag and send the last status update
          pf%state%status = PF_STATUS_CONVERGED
          call pf_send_status(pf, send_tag, dir)
       end if
    else
       !  I am not converged, send the news
       pf%state%status = PF_STATUS_ITERATING
       call pf_send_status(pf, send_tag, dir)
    end if
    
    call call_hooks(pf, 1, PF_POST_CONVERGENCE)
    
    !!! old code below
    ! Check to see if tolerances are met   
!     residual1 = pf%levels(pf%nlevels)%residual
!     if (pf%state%status == PF_STATUS_ITERATING .and. residual > 0.0d0) then
!        if ( (abs(1.0_pfdp - abs(residual1/residual)) < pf%rel_res_tol) .or. &
!             (abs(residual1)                          < pf%abs_res_tol) ) then
!           pf%state%status = PF_STATUS_CONVERGED
!        end if
!     end if
!         
!     !->why? how to do that more cleanly?
!     if (pf%state%status == PF_STATUS_ITERATING .and. residual >= 0.0d0) then    
!                 ! if do_mixed, adjoint on last time step will be constant zero, so residual will be zero
!                 ! need to stop in that case as well, but not in the very first iteration
!       if( abs(residual1) < pf%abs_res_tol ) then
!           pf%state%status = PF_STATUS_CONVERGED
!       end if
!     end if
!     !!-
!     
!     residual = residual1
! 
!     call call_hooks(pf, 1, PF_PRE_CONVERGENCE)
!     if (pf%state%pstatus /= PF_STATUS_CONVERGED) call pf_recv_status(pf, 1+k, dir)
! 
!     if (pf%rank /= 0 .and. pf%state%pstatus == PF_STATUS_ITERATING .and. dir == 1) &
!          pf%state%status = PF_STATUS_ITERATING
!     if (pf%rank /= pf%comm%nproc-1 .and. pf%state%pstatus == PF_STATUS_ITERATING .and. dir == 2) &
!          pf%state%status = PF_STATUS_ITERATING
!          
! !     if (pf%state%status .ne. PF_STATUS_CONVERGED) 
!     call pf_send_status(pf, 1+k, dir)
!     call call_hooks(pf, 1, PF_POST_CONVERGENCE)
! 
!     ! XXX: this ain't so pretty, perhaps we should use the
!     ! 'nmoved' thinger to break this cycle if everyone is
!     ! done...
! 
!     if (pf%state%status == PF_STATUS_CONVERGED) then
!        converged = .true.
!        return
!     end if
! 
!     if (0 == pf%comm%nproc) then
!        pf%state%status = PF_STATUS_PREDICTOR
!        converged = .true.
!        return
!     end if

  end subroutine pf_check_convergence_oc