B.1.9 Consolidate_Status Procedure

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

  subroutine Consolidate_Status (Consolidated_S, Multiple_S)

    ! Input variable.

    ! Vector of status variables to be consolidated:
    type(Status_type), intent(in), dimension(:) :: Multiple_S 

    ! Output variable.

    type(Status_type), intent(out) :: Consolidated_S  ! Consolidated status.

    ! Internal variable.

    type(integer) :: i  ! Loop counter.

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

    ! Verify requirements.

    VERIFY(Valid_State(Multiple_S),1)   ! Multiple_S is valid.

    ! The following table shows the value of Consolidated_S after it has been
    ! combined with a single value from the vector Multiple_S, based on the 
    ! previous value of Consolidated_S:
    !
    !                                          Multiple_S(i)
    !   
    !                             Unset    Success  ME  MW  Error  Warning
    !                           +------------------------------------------+
    !                   Unset   | Unset    Success  ME  MW  Error  Warning |
    !                   Success | Success  Success  ME  MW  Error  Warning |
    !                   ME      | ME       ME       ME  ME  ME     ME      |
    !   Consolidated_S  MW      | MW       MW       ME  MW  ME     MW      |
    !     (previous)    Error   | Error    Error    ME  ME  ME*    ME      |
    !                   Warning | Warning  Warning  ME  MW  ME     MW*     |
    !                           +------------------------------------------+
    !   
    !   ME: Multiple Error
    !   MW: Multiple Warning
    !   *: Multiple Error or Warning is only set 
    !      if the two errors or warnings differ.
    !
    ! Notice that this matrix is symmetric.

    ! Start out Unset.

    Consolidated_S = 'Unset'

    ! Loop over Multiple_S vector.

    do i = 1, SIZE(Multiple_S)

      ! Switch on Multiple_S(i).

      select case (status_flag(Multiple_S(i)%status)%selector)

      ! Multiple_S(i) = 'Unset'
      !
      !   Consolidated_S (old):  Unset    Success  ME  MW  Error  Warning
      !   Consolidated_S (new):  Unset    Success  ME  MW  Error  Warning

      case ('Unset')

        ! Do not modify Consolidated_S.

      ! Multiple_S(i) = 'Success'
      !
      !   Consolidated_S (old):  Unset    Success  ME  MW  Error  Warning
      !   Consolidated_S (new):  Success  Success  ME  MW  Error  Warning

      case ('Success')

        if (status_flag(Consolidated_S%status)%selector == 'Unset') then
          Consolidated_S = 'Success'
        end if

      ! Multiple_S(i) = 'Multiple Error'
      !
      !   Consolidated_S (old):  Unset    Success  ME  MW  Error  Warning
      !   Consolidated_S (new):  ME       ME       ME  ME  ME     ME     

      case ('Multiple Error')

        Consolidated_S = 'Multiple Error'

      ! Multiple_S(i) = 'Multiple Warning'
      !
      !   Consolidated_S (old):  Unset    Success  ME  MW  Error  Warning
      !   Consolidated_S (new):  MW       MW       ME  MW  ME     MW     

      case ('Multiple Warning')

        if (Error(Consolidated_S)) then
          Consolidated_S = 'Multiple Error'
        else
          Consolidated_S = 'Multiple Warning'
        end if

      case default

        ! Multiple_S(i) = 'Error'
        !
        !   Consolidated_S (old):  Unset    Success  ME  MW  Error  Warning
        !   Consolidated_S (new):  Error    Error    ME  ME  ME*    ME     

        if (Error(Multiple_S(i))) then

          if (Error(Consolidated_S)) then
            if (Consolidated_S /= Multiple_S(i)) then
              Consolidated_S = 'Multiple Error'
            end if
          else if (Warning(Consolidated_S)) then
            Consolidated_S = 'Multiple Error'
          else
            Consolidated_S = Multiple_S(i)
          end if

        ! Multiple_S(i) = 'Warning'
        !
        !   Consolidated_S (old):  Unset    Success  ME  MW  Error  Warning
        !   Consolidated_S (new):  Warning  Warning  ME  MW  ME     MW*

        else if (Warning(Multiple_S(i))) then

          if (Error(Consolidated_S)) then
            Consolidated_S = 'Multiple Error'
          else if (Warning(Consolidated_S)) then
            if (Consolidated_S /= Multiple_S(i)) then
              Consolidated_S = 'Multiple Warning'
            end if
          else
            Consolidated_S = Multiple_S(i)
          end if

        ! This condition should not be hit.

        else

          write (6,*) 'Consolidate_Status: Impossible Status Combination Hit.'

        end if

      end select

    ! End of loop over Multiple_S vector.

    end do

    ! Verify guarantees.

    VERIFY(Valid_State(Consolidated_S),1)   ! Consolidated_S is valid.

    !VERIFY(,2)

    return
  end subroutine Consolidate_Status