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