E.2.3 Valid_State_Statistics Procedure

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

  function Valid_State_Statistics (Statistics) result(Valid)

    ! Use association information.
  
    use Caesar_Numbers_Module, only: ten

    ! Input variables.

    ! Variable to be checked.
    type(Statistics_type), intent(in) :: Statistics  

    ! Output variables.

    type(logical) :: Valid             ! Logical state.

    ! Internal variables.

    type(real) :: expand_left, expand_right        ! Range expansion amounts.
    type(real), dimension(2) :: Global_Mean_Range  ! Global range of the means.
    type(real), dimension(2) :: Global_Range   ! Global range of the variables.
    type(real), dimension(2) :: PE_Mean_Range  ! Range of the means on this PE.
    type(real), dimension(2) :: PE_Range   ! Range of the variables on this PE.

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

    ! Start out true.

    Valid = .true.

    ! Check for validity of internals.

    Valid = Valid .and. Initialized(Statistics)
    Valid = Valid .and. Valid_State(Statistics%PE_Count)
    Valid = Valid .and. Valid_State(Statistics%PE_Arithmetic_Mean)
    Valid = Valid .and. Valid_State(Statistics%PE_Sum)
    Valid = Valid .and. Valid_State(Statistics%PE_Geometric_Mean)
    Valid = Valid .and. Valid_State(Statistics%PE_Log_Sum)
    Valid = Valid .and. Valid_State(Statistics%PE_Harmonic_Mean)
    Valid = Valid .and. Valid_State(Statistics%PE_Reciprocal_Sum)
    Valid = Valid .and. Valid_State(Statistics%PE_Standard_Deviation)
    Valid = Valid .and. Valid_State(Statistics%PE_Squared_Sum)
    Valid = Valid .and. Valid_State(Statistics%PE_Maximum)
    Valid = Valid .and. Valid_State(Statistics%PE_Minimum)
    Valid = Valid .and. Valid_State(Statistics%PE_Totally_Positive)
    Valid = Valid .and. Valid_State(Statistics%Global_Count)
    Valid = Valid .and. Valid_State(Statistics%Global_Arithmetic_Mean)
    Valid = Valid .and. Valid_State(Statistics%Global_Sum)
    Valid = Valid .and. Valid_State(Statistics%Global_Geometric_Mean)
    Valid = Valid .and. Valid_State(Statistics%Global_Log_Sum)
    Valid = Valid .and. Valid_State(Statistics%Global_Harmonic_Mean)
    Valid = Valid .and. Valid_State(Statistics%Global_Reciprocal_Sum)
    Valid = Valid .and. Valid_State(Statistics%Global_Standard_Deviation)
    Valid = Valid .and. Valid_State(Statistics%Global_Squared_Sum)
    Valid = Valid .and. Valid_State(Statistics%Global_Maximum)
    Valid = Valid .and. Valid_State(Statistics%Global_Minimum)
    Valid = Valid .and. Valid_State(Statistics%Global_Updated)
    Valid = Valid .and. Valid_State(Statistics%Global_Totally_Positive)
    Valid = Valid .and. Valid_State(Statistics%Name)
    if (.not.Valid) return

    ! Checks on the validity of Statistics.

    ! Range checks. 

    ! All of the ranges have been expanded *slightly* by using the Fortran
    ! intrinsic SPACING. This was needed for small roundoff errors that
    ! were triggered when there was only a single value in the object.

    ! Set range expansion values.

    expand_left  = ten*MAX(SPACING(Statistics%PE_Minimum), &
                           SPACING(Statistics%Global_Minimum), &
                           SPACING(Statistics%PE_Harmonic_Mean), &
                           SPACING(Statistics%Global_Harmonic_Mean) )
    expand_right = ten*MAX(SPACING(Statistics%PE_Maximum), &
                           SPACING(Statistics%Global_Maximum), &
                           SPACING(Statistics%PE_Arithmetic_Mean), &
                           SPACING(Statistics%Global_Arithmetic_Mean) )

    PE_Range = (/ Statistics%PE_Minimum - expand_left, &
                  Statistics%PE_Maximum + expand_right /)
    Valid = Valid .and. Statistics%PE_Maximum >= Statistics%PE_Minimum
    Valid = Valid .and. (Statistics%PE_Arithmetic_Mean .InInterval. PE_Range)
    Valid = Valid .and. (Statistics%PE_Geometric_Mean .InInterval. PE_Range)
    Valid = Valid .and. (Statistics%PE_Harmonic_Mean .InInterval. PE_Range)

    if (Statistics%Global_Updated) then
      Global_Range = (/ Statistics%Global_Minimum - expand_left, &
                        Statistics%Global_Maximum + expand_right /)
      Valid = Valid .and. &
              Statistics%Global_Maximum >= Statistics%Global_Minimum
      Valid = Valid .and. &
              (Statistics%PE_Maximum .InInterval. Global_Range)
      Valid = Valid .and. &
              (Statistics%PE_Minimum .InInterval. Global_Range)
      Valid = Valid .and. &
              (Statistics%Global_Arithmetic_Mean .InInterval. Global_Range)
      Valid = Valid .and. &
              (Statistics%Global_Geometric_Mean .InInterval. Global_Range)
      Valid = Valid .and. &
              (Statistics%Global_Harmonic_Mean .InInterval. Global_Range)
    endif

    ! Mathematically, the geometric mean must be less than the arithmetic 
    ! mean and greater than the harmonic mean.

    if (Statistics%PE_Totally_Positive) then
      PE_Mean_Range = (/ Statistics%PE_Harmonic_Mean   - expand_left, &
                         Statistics%PE_Arithmetic_Mean + expand_right /)
      Valid = Valid .and. &
              (Statistics%PE_Geometric_Mean .InInterval. PE_Mean_Range)
    end if
    if (Statistics%Global_Updated .and. &
        Statistics%Global_Totally_Positive) then
      Global_Mean_Range = &
        (/ Statistics%Global_Harmonic_Mean   - expand_left, &
           Statistics%Global_Arithmetic_Mean + expand_right /)
      Valid = Valid .and. &
              (Statistics%Global_Geometric_Mean .InInterval. Global_Mean_Range)
    endif

    return
  end function Valid_State_Statistics



Michael L. Hall