B.1.13 Set_Status Procedure

The main documentation of the Set_Status Procedure contains additional explanation of this code listing.

  subroutine Set_Status (S, Selector_Flag)

    ! Input variable.

    ! String to select status value.
    type(character,*), intent(in) :: Selector_Flag 

    ! Output variable.

    type(Status_type), intent(out) :: S  ! Status to be set.

    ! Internal variable.

    type(integer) :: i  ! Loop counter.

    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    ! Verify requirements.

    ! Selector_Flag must be one of the possible flags.
    VERIFY(ANY(Selector_Flag == status_flag%selector),1)

    ! Determine which flag is to be set.

    do i = 1, NFlags
      if (Selector_Flag == status_flag(i)%selector) S%status = i
    end do

    ! Verify guarantees.

    VERIFY(Valid_State(S),1)   ! S is now valid.

    return
  end subroutine Set_Status