| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| type(RootFinderDataType), | intent(inout) | :: | RootFinderData | |||
| real(kind=r64), | intent(in) | :: | X | |||
| real(kind=r64), | intent(in) | :: | Y |
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
Nodes of different colours represent the following:
Solid arrows point from a procedure to one which it calls. Dashed arrows point from an interface to procedures which implement that interface. This could include the module procedures in a generic interface or the implementation in a submodule of an interface in a parent module. Where possible, edges connecting nodes are given different colours to make them easier to distinguish in large graphs.
SUBROUTINE UpdateBracket( RootFinderData, X, Y )
! SUBROUTINE INFORMATION:
! AUTHOR Dimitri Curtil (LBNL)
! DATE WRITTEN March 2006
! MODIFIED
! RE-ENGINEERED na
! PURPOSE OF THIS SUBROUTINE:
! This subroutine updates the lower/upper support points in the root finder data
! with the current iterate (X,Y).
!
! METHODOLOGY EMPLOYED:
!
! PRECONDITION:
! - The current iterate (X,Y) must satisfy:
! MinPoint%X <= LowerPoint%X < X < UpperPoint%X <= MaxPoint%X
! - RootFinderData%StatusFlag == iStatusNone
!
! POSTCONDITION:
! - RootFinderData%LowerPoint possibly updated
! - RootFinderData%UpperPoint possibly updated
! - RootFinderData%StatusFlag possibly updated with:
! - iStatusWarningNonMonotonic
! - iStatusWarningSingular
!
! REFERENCES:
! na
! USE STATEMENTS:
! na
IMPLICIT NONE ! Enforce explicit typing of all variables in this routine
! SUBROUTINE ARGUMENT DEFINITIONS:
TYPE(RootFinderDataType), INTENT(INOUT) :: RootFinderData ! Data used by root finding algorithm
REAL(r64), INTENT(IN) :: X ! X value for current iterate
REAL(r64), INTENT(IN) :: Y ! Y value for current iterate, F(X)=Y
! SUBROUTINE PARAMETER DEFINITIONS:
! na
! INTERFACE BLOCK SPECIFICATIONS
! na
! DERIVED TYPE DEFINITIONS
! na
! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
! na
! FLOW:
SelectSlope: SELECT CASE ( RootFinderData%Controls%SlopeType )
CASE ( iSlopeIncreasing )
! Update lower point
IF ( Y <= 0.0d0 ) THEN
IF ( .NOT.RootFinderData%LowerPoint%DefinedFlag ) THEN
RootFinderData%LowerPoint%DefinedFlag = .TRUE.
RootFinderData%LowerPoint%X = X
RootFinderData%LowerPoint%Y = Y
ELSE
IF ( X >= RootFinderData%LowerPoint%X ) THEN
IF ( Y == RootFinderData%LowerPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningSingular
ELSE IF ( Y < RootFinderData%LowerPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningNonMonotonic
END IF
! Update lower point with current iterate
RootFinderData%LowerPoint%X = X
RootFinderData%LowerPoint%Y = Y
ELSE
! Should never happen if CheckLowerUpperBracket() is called before
CALL ShowSevereError('UpdateBracket: Current iterate is smaller than the lower bracket.')
CALL ShowContinueError( &
'UpdateBracket: '// &
'X='//TRIM(TrimSigDigits(X,15))//', '// &
'Y='//TRIM(TrimSigDigits(Y,15)) &
)
CALL ShowContinueError( &
'UpdateBracket: '// &
'XLower='//TRIM(TrimSigDigits(RootFinderData%LowerPoint%X,15))//', '// &
'YLower='//TRIM(TrimSigDigits(RootFinderData%LowerPoint%Y,15)) &
)
CALL ShowFatalError('UpdateBracket: Preceding error causes program termination.')
END IF
END IF
! Update upper point
ELSE
IF ( .NOT.RootFinderData%UpperPoint%DefinedFlag ) THEN
RootFinderData%UpperPoint%DefinedFlag = .TRUE.
RootFinderData%UpperPoint%X = X
RootFinderData%UpperPoint%Y = Y
ELSE
IF ( X <= RootFinderData%UpperPoint%X ) THEN
IF ( Y == RootFinderData%UpperPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningSingular
ELSE IF ( Y > RootFinderData%UpperPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningNonMonotonic
END IF
! Update upper point with current iterate
RootFinderData%UpperPoint%X = X
RootFinderData%UpperPoint%Y = Y
ELSE
! Should never happen if CheckLowerUpperBracket() is called before
CALL ShowSevereError('UpdateBracket: Current iterate is greater than the upper bracket.')
CALL ShowContinueError( &
'UpdateBracket: '// &
'X='//TRIM(TrimSigDigits(X,15))//', '// &
'Y='//TRIM(TrimSigDigits(Y,15)) &
)
CALL ShowContinueError( &
'UpdateBracket: '// &
'XUpper='//TRIM(TrimSigDigits(RootFinderData%UpperPoint%X,15))//', '// &
'YUpper='//TRIM(TrimSigDigits(RootFinderData%UpperPoint%Y,15)) &
)
CALL ShowFatalError('UpdateBracket: Preceding error causes program termination.')
END IF
END IF
END IF
! Monotone, decreasing function
CASE ( iSlopeDecreasing )
! Update lower point
IF ( Y >= 0.0d0 ) THEN
IF ( .NOT.RootFinderData%LowerPoint%DefinedFlag ) THEN
RootFinderData%LowerPoint%DefinedFlag = .TRUE.
RootFinderData%LowerPoint%X = X
RootFinderData%LowerPoint%Y = Y
ELSE
IF ( X >= RootFinderData%LowerPoint%X ) THEN
IF ( Y == RootFinderData%LowerPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningSingular
ELSE IF ( Y > RootFinderData%LowerPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningNonMonotonic
END IF
! Update lower point with current iterate
RootFinderData%LowerPoint%X = X
RootFinderData%LowerPoint%Y = Y
ELSE
! Should never happen if CheckLowerUpperBracket() is called before
CALL ShowSevereError('UpdateBracket: Current iterate is smaller than the lower bracket.')
CALL ShowContinueError( &
'UpdateBracket: '// &
'X='//TRIM(TrimSigDigits(X,15))//', '// &
'Y='//TRIM(TrimSigDigits(Y,15)) &
)
CALL ShowContinueError( &
'UpdateBracket: '// &
'XLower='//TRIM(TrimSigDigits(RootFinderData%LowerPoint%X,15))//', '// &
'YLower='//TRIM(TrimSigDigits(RootFinderData%LowerPoint%Y,15)) &
)
CALL ShowFatalError('UpdateBracket: Preceding error causes program termination.')
END IF
END IF
! Update upper point
ELSE
IF ( .NOT.RootFinderData%UpperPoint%DefinedFlag ) THEN
RootFinderData%UpperPoint%DefinedFlag = .TRUE.
RootFinderData%UpperPoint%X = X
RootFinderData%UpperPoint%Y = Y
ELSE
IF ( X <= RootFinderData%UpperPoint%X ) THEN
IF ( Y == RootFinderData%UpperPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningSingular
ELSE IF ( Y < RootFinderData%UpperPoint%Y ) THEN
RootFinderData%StatusFlag = iStatusWarningNonMonotonic
END IF
! Update upper point with current iterate
RootFinderData%UpperPoint%X = X
RootFinderData%UpperPoint%Y = Y
ELSE
! Should never happen if CheckLowerUpperBracket() is called before
CALL ShowSevereError('UpdateBracket: Current iterate is greater than the upper bracket.')
CALL ShowContinueError( &
'UpdateBracket: '// &
'X='//TRIM(TrimSigDigits(X,15))//', '// &
'Y='//TRIM(TrimSigDigits(Y,15)) &
)
CALL ShowContinueError( &
'UpdateBracket: '// &
'XUpper='//TRIM(TrimSigDigits(RootFinderData%UpperPoint%X,15))//', '// &
'YUpper='//TRIM(TrimSigDigits(RootFinderData%UpperPoint%Y,15)) &
)
CALL ShowFatalError('UpdateBracket: Preceding error causes program termination.')
END IF
END IF
END IF
CASE DEFAULT
! Should never happen
CALL ShowSevereError('UpdateBracket: Invalid function slope specification. Valid choices are:')
CALL ShowContinueError('UpdateBracket: iSlopeIncreasing='//TRIM(TrimSigDigits(iSlopeIncreasing)))
CALL ShowContinueError('UpdateBracket: iSlopeDecreasing='//TRIM(TrimSigDigits(iSlopeDecreasing)))
CALL ShowFatalError('UpdateBracket: Preceding error causes program termination.')
END SELECT SelectSlope
RETURN
END SUBROUTINE UpdateBracket