*DECK CHFCM
INTEGER FUNCTION CHFCM (D1, D2, DELTA)
C***BEGIN PROLOGUE CHFCM
C***SUBSIDIARY
C***PURPOSE Check a single cubic for monotonicity.
C***LIBRARY SLATEC (PCHIP)
C***TYPE SINGLE PRECISION (CHFCM-S, DCHFCM-D)
C***AUTHOR Fritsch, F. N., (LLNL)
C***DESCRIPTION
C
C *Usage:
C
C REAL D1, D2, DELTA
C INTEGER ISMON, CHFCM
C
C ISMON = CHFCM (D1, D2, DELTA)
C
C *Arguments:
C
C D1,D2:IN are the derivative values at the ends of an interval.
C
C DELTA:IN is the data slope over that interval.
C
C *Function Return Values:
C ISMON : indicates the monotonicity of the cubic segment:
C ISMON = -3 if function is probably decreasing;
C ISMON = -1 if function is strictly decreasing;
C ISMON = 0 if function is constant;
C ISMON = 1 if function is strictly increasing;
C ISMON = 2 if function is non-monotonic;
C ISMON = 3 if function is probably increasing.
C If ABS(ISMON)=3, the derivative values are too close to the
C boundary of the monotonicity region to declare monotonicity
C in the presence of roundoff error.
C
C *Description:
C
C CHFCM: Cubic Hermite Function -- Check Monotonicity.
C
C Called by PCHCM to determine the monotonicity properties of the
C cubic with boundary derivative values D1,D2 and chord slope DELTA.
C
C *Cautions:
C This is essentially the same as old CHFMC, except that a
C new output value, -3, was added February 1989. (Formerly, -3
C and +3 were lumped together in the single value 3.) Codes that
C flag nonmonotonicity by "IF (ISMON.EQ.2)" need not be changed.
C Codes that check via "IF (ISMON.GE.3)" should change the test to
C "IF (IABS(ISMON).GE.3)". Codes that declare monotonicity via
C "IF (ISMON.LE.1)" should change to "IF (IABS(ISMON).LE.1)".
C
C REFER TO PCHCM
C
C***ROUTINES CALLED R1MACH
C***REVISION HISTORY (YYMMDD)
C 820518 DATE WRITTEN
C 820805 Converted to SLATEC library version.
C 831201 Changed from ISIGN to SIGN to correct bug that
C produced wrong sign when -1 .LT. DELTA .LT. 0 .
C 890206 Added SAVE statements.
C 890207 Added sign to returned value ISMON=3 and corrected
C argument description accordingly.
C 890306 Added caution about changed output.
C 890407 Changed name from CHFMC to CHFCM, as requested at the
C March 1989 SLATEC CML meeting, and made a few other
C minor modifications necessitated by this change.
C 890407 Converted to new SLATEC format.
C 890407 Modified DESCRIPTION to LDOC format.
C 891214 Moved SAVE statements. (WRB)
C***END PROLOGUE CHFCM
C
C Fortran intrinsics used: SIGN.
C Other routines used: R1MACH.
C
C ----------------------------------------------------------------------
C
C Programming notes:
C
C TEN is actually a tuning parameter, which determines the width of
C the fuzz around the elliptical boundary.
C
C To produce a double precision version, simply:
C a. Change CHFCM to DCHFCM wherever it occurs,
C b. Change the real declarations to double precision, and
C c. Change the constants ZERO, ONE, ... to double precision.
C
C DECLARE ARGUMENTS.
C
REAL D1, D2, DELTA
C
C DECLARE LOCAL VARIABLES.
C
INTEGER ISMON, ITRUE
REAL A, B, EPS, FOUR, ONE, PHI, TEN, THREE, TWO, ZERO
SAVE ZERO, ONE, TWO, THREE, FOUR
SAVE TEN
C
C INITIALIZE.
C
DATA ZERO /0./, ONE /1.0/, TWO /2./, THREE /3./, FOUR /4./,
1 TEN /10./
C
C MACHINE-DEPENDENT PARAMETER -- SHOULD BE ABOUT 10*UROUND.
C***FIRST EXECUTABLE STATEMENT CHFCM
EPS = TEN*R1MACH(4)
C
C MAKE THE CHECK.
C
IF (DELTA .EQ. ZERO) THEN
C CASE OF CONSTANT DATA.
IF ((D1.EQ.ZERO) .AND. (D2.EQ.ZERO)) THEN
ISMON = 0
ELSE
ISMON = 2
ENDIF
ELSE
C DATA IS NOT CONSTANT -- PICK UP SIGN.
ITRUE = SIGN (ONE, DELTA)
A = D1/DELTA
B = D2/DELTA
IF ((A.LT.ZERO) .OR. (B.LT.ZERO)) THEN
ISMON = 2
ELSE IF ((A.LE.THREE-EPS) .AND. (B.LE.THREE-EPS)) THEN
C INSIDE SQUARE (0,3)X(0,3) IMPLIES OK.
ISMON = ITRUE
ELSE IF ((A.GT.FOUR+EPS) .AND. (B.GT.FOUR+EPS)) THEN
C OUTSIDE SQUARE (0,4)X(0,4) IMPLIES NONMONOTONIC.
ISMON = 2
ELSE
C MUST CHECK AGAINST BOUNDARY OF ELLIPSE.
A = A - TWO
B = B - TWO
PHI = ((A*A + B*B) + A*B) - THREE
IF (PHI .LT. -EPS) THEN
ISMON = ITRUE
ELSE IF (PHI .GT. EPS) THEN
ISMON = 2
ELSE
C TO CLOSE TO BOUNDARY TO TELL,
C IN THE PRESENCE OF ROUND-OFF ERRORS.
ISMON = 3*ITRUE
ENDIF
ENDIF
ENDIF
C
C RETURN VALUE.
C
CHFCM = ISMON
RETURN
C------------- LAST LINE OF CHFCM FOLLOWS ------------------------------
END