CheckInternalConsistency Function

private function CheckInternalConsistency(RootFinderData)

Arguments

Type	Intent	Optional	Attributes		Name
type(RootFinderDataType),	intent(in)			::	RootFinderData
Return Value integer

Calls

Help
Source Code

CheckInternalConsistency
Source Code

INTEGER FUNCTION CheckInternalConsistency( RootFinderData )
          ! FUNCTION INFORMATION:
          !       AUTHOR         Dimitri Curtil (LBNL)
          !       DATE WRITTEN   March 2006
          !       MODIFIED
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS FUNCTION:
          ! This function checks whether the lower and upper points (if defined)
          ! determine a consistent interval bracketting the root.
          !
          ! Returns the status code accordingly.
          !
          ! This function does not modify the argument RooFinderData.
          !
          ! Only used internally for debugging.
          !

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
          ! na

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! FUNCTION ARGUMENT DEFINITIONS:
  TYPE(RootFinderDataType), INTENT(IN)    :: RootFinderData ! Data used by root finding algorithm

          ! FUNCTION PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! FUNCTION LOCAL VARIABLE DECLARATIONS:
          ! na

          ! FLOW:

  ! Default initialization
  CheckInternalConsistency = iStatusNone

  ! Internal consistency check involving both support points
  IF ( RootFinderData%LowerPoint%DefinedFlag .AND. RootFinderData%UpperPoint%DefinedFlag ) THEN

    ! Check that the existing lower and upper points do bracket the root
    IF ( RootFinderData%LowerPoint%X > RootFinderData%UpperPoint%X ) THEN
      CheckInternalConsistency = iStatusErrorRange
      RETURN
    END IF

    ! Check for non-monotonicity between the existing lower and upper points
    SELECT CASE ( RootFinderData%Controls%SlopeType )
    CASE (iSlopeIncreasing)
      ! Y-value of lower point must be strictly smaller than Y-value of upper point
      IF ( RootFinderData%LowerPoint%Y > RootFinderData%UpperPoint%Y ) THEN
        CheckInternalConsistency = iStatusWarningNonMonotonic
        RETURN
      END IF

    CASE (iSlopeDecreasing)
      ! Y-value of lower point must be strictly larger than Y-value of upper point
      IF ( RootFinderData%LowerPoint%Y < RootFinderData%UpperPoint%Y ) THEN
        CheckInternalConsistency = iStatusWarningNonMonotonic
        RETURN
      END IF

    CASE DEFAULT
      ! Should never happen
      CALL ShowSevereError('CheckInternalConsistency: Invalid function slope specification. Valid choices are:')
      CALL ShowContinueError('CheckInternalConsistency: iSlopeIncreasing='//TRIM(TrimSigDigits(iSlopeIncreasing)))
      CALL ShowContinueError('CheckInternalConsistency: iSlopeDecreasing='//TRIM(TrimSigDigits(iSlopeDecreasing)))
      CALL ShowFatalError('CheckInternalConsistency: Preceding error causes program termination.')
    END SELECT

    ! Check for in singularity with respect to the existing lower and upper points
    ! Only check if the lower and upper points are distinct!
    IF ( RootFinderData%UpperPoint%X > RootFinderData%LowerPoint%X ) THEN
      IF ( RootFinderData%UpperPoint%Y == RootFinderData%LowerPoint%Y ) THEN
        CheckInternalConsistency = iStatusErrorSingular
        RETURN
      END IF
    END IF

  END IF


  ! Check min constraint for min point if already defined
  IF ( RootFinderData%MinPoint%DefinedFlag ) THEN
    SELECT CASE ( RootFinderData%Controls%SlopeType )
    CASE ( iSlopeIncreasing )
      IF ( RootFinderData%MinPoint%Y >= 0.0d0 ) THEN
        CheckInternalConsistency = iStatusOKMin
        RETURN
      END IF

    CASE ( iSlopeDecreasing )
      IF ( RootFinderData%MinPoint%Y <= 0.0d0 ) THEN
        CheckInternalConsistency = iStatusOKMin
        RETURN
      END IF

    CASE DEFAULT
      ! Should never happen
      CALL ShowSevereError('CheckInternalConsistency: Invalid function slope specification. Valid choices are:')
      CALL ShowContinueError('CheckInternalConsistency: iSlopeIncreasing='//TRIM(TrimSigDigits(iSlopeIncreasing)))
      CALL ShowContinueError('CheckInternalConsistency: iSlopeDecreasing='//TRIM(TrimSigDigits(iSlopeDecreasing)))
      CALL ShowFatalError('CheckInternalConsistency: Preceding error causes program termination.')
    END SELECT
  END IF


  ! Check max constraint for max point if already defined
  IF ( RootFinderData%MaxPoint%DefinedFlag ) THEN
    SELECT CASE ( RootFinderData%Controls%SlopeType )
    CASE ( iSlopeIncreasing )
      IF ( RootFinderData%MaxPoint%Y <= 0.0d0 ) THEN
        CheckInternalConsistency = iStatusOKMax
        RETURN
      END IF

    CASE ( iSlopeDecreasing )
      IF ( RootFinderData%MaxPoint%Y >= 0.0d0 ) THEN
        CheckInternalConsistency = iStatusOKMax
        RETURN
      END IF

    CASE DEFAULT
      ! Should never happen
      CALL ShowSevereError('CheckInternalConsistency: Invalid function slope specification. Valid choices are:')
      CALL ShowContinueError('CheckInternalConsistency: iSlopeIncreasing='//TRIM(TrimSigDigits(iSlopeIncreasing)))
      CALL ShowContinueError('CheckInternalConsistency: iSlopeDecreasing='//TRIM(TrimSigDigits(iSlopeDecreasing)))
      CALL ShowFatalError('CheckInternalConsistency: Preceding error causes program termination.')
    END SELECT
  END IF

  RETURN
END FUNCTION CheckInternalConsistency
All Procedures
