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