G.1.4 Valid_State_Mathematic_Vector Procedure

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

  function Valid_State_Mathematic_Vector (MV) result(Valid)

    ! Use association information.

    use Caesar_Numbers_Module, only: zero, ten

    ! Input variables.

    ! Variable to be checked.
    type(Mathematic_Vector_type), intent(in) :: MV  

    ! Output variables.

    type(logical) :: Valid             ! Logical state.

    ! Internal variables.

    type(integer) :: i                 ! Loop variable.
    type(real) :: N                    ! Total length of the MV.

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

    ! Start out true.

    Valid = .true.

    ! Check for association of pointered internals.

    Valid = Valid .and. ASSOCIATED(MV%Structure)
    if (.not.Valid) return

    ! Check for validity of internals.

    Valid = Valid .and. Initialized(MV)
    Valid = Valid .and. Valid_State(MV%Average)
    Valid = Valid .and. Valid_State(MV%Average_is_Updated)
    if (Initialized(MV%DV)) then
      Valid = Valid .and. Valid_State(MV%DV)
    end if
    Valid = Valid .and. Valid_State(MV%Infinity_Norm)
    Valid = Valid .and. Valid_State(MV%Infinity_Norm_is_Updated)
    Valid = Valid .and. Valid_State(MV%Maximum)
    Valid = Valid .and. Valid_State(MV%Maximum_is_Updated)
    Valid = Valid .and. Valid_State(MV%Minimum)
    Valid = Valid .and. Valid_State(MV%Minimum_is_Updated)
    Valid = Valid .and. Valid_State(MV%Name)
    Valid = Valid .and. Valid_State(MV%One_Norm)
    Valid = Valid .and. Valid_State(MV%One_Norm_is_Updated)
    do i = 1, Number_of_OVs_in_an_MV
      if (Initialized(MV%OV(i))) then
        Valid = Valid .and. Valid_State(MV%OV(i))
      end if
    end do
    Valid = Valid .and. Valid_State(MV%DV_is_Updated)
    Valid = Valid .and. Valid_State(MV%P_Norm)
    Valid = Valid .and. Valid_State(MV%P_Norm_Exponent)
    Valid = Valid .and. Valid_State(MV%P_Norm_is_Updated)
    Valid = Valid .and. Valid_State(MV%Structure)
    Valid = Valid .and. Valid_State(MV%Sum)
    Valid = Valid .and. Valid_State(MV%Sum_is_Updated)
    Valid = Valid .and. Valid_State(MV%Two_Norm)
    Valid = Valid .and. Valid_State(MV%Two_Norm_is_Updated)
    if (.not.Valid) return

    ! Checks on the validity of Mathematic_Vector.

    Valid = Valid .and. MV%Infinity_Norm >= zero
    Valid = Valid .and. MV%One_Norm >= zero
    Valid = Valid .and. MV%P_Norm >= zero
    Valid = Valid .and. MV%Two_Norm >= zero
    if (MV%One_Norm_is_updated .and. MV%Sum_is_updated) then
      Valid = Valid .and. MV%One_Norm >= MV%Sum
    end if
    if (MV%Average_is_updated .and. MV%Sum_is_updated) then
      Valid = Valid .and. &
              VeryClose(MV%Average, MV%Sum/Length_Total(MV%Structure))
    end if
    if (MV%Maximum_is_updated .and. MV%Minimum_is_updated) then
      Valid = Valid .and. MV%Maximum >= MV%Minimum
    end if
    if (.not.Valid) return

    ! Mathematic relationship checks. 
    ! SPACING calls are used to avoid problems with round-off.

    N = changetype(real, Length_Total(MV%Structure))
    if (MV%One_Norm_is_updated .and. MV%Two_Norm_is_updated) then
      Valid = Valid .and. &
              MV%One_Norm >= MV%Two_Norm - ten * SPACING(MV%Two_Norm)
      Valid = Valid .and. &
              MV%Two_Norm * SQRT(N) >= MV%One_Norm - ten * SPACING(MV%One_Norm)
    end if
    if (MV%Infinity_Norm_is_updated .and. MV%Two_Norm_is_updated) then
      Valid = Valid .and. &
              MV%Two_Norm >= MV%Infinity_Norm - ten * SPACING(MV%Infinity_Norm)
      Valid = Valid .and. &
              MV%Infinity_Norm * SQRT(N) >= MV%Two_Norm &
                                            - ten * SPACING(MV%Two_Norm)
    end if
    if (MV%Infinity_Norm_is_updated .and. MV%One_Norm_is_updated) then
      Valid = Valid .and. &
              MV%One_Norm >= MV%Infinity_Norm - ten * SPACING(MV%Infinity_Norm)
      Valid = Valid .and. &
              MV%Infinity_Norm * N >= MV%One_Norm - ten * SPACING(MV%One_Norm)
    end if

    return
  end function Valid_State_Mathematic_Vector