1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
*DECK DCHFCM
INTEGER FUNCTION DCHFCM (D1, D2, DELTA)
C***BEGIN PROLOGUE DCHFCM
C***SUBSIDIARY
C***PURPOSE Check a single cubic for monotonicity.
C***LIBRARY SLATEC (PCHIP)
C***TYPE DOUBLE PRECISION (CHFCM-S, DCHFCM-D)
C***AUTHOR Fritsch, F. N., (LLNL)
C***DESCRIPTION
C
C *Usage:
C
C DOUBLE PRECISION D1, D2, DELTA
C INTEGER ISMON, DCHFCM
C
C ISMON = DCHFCM (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 DCHFCM: Cubic Hermite Function -- Check Monotonicity.
C
C Called by DPCHCM 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 DCHFMC, 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 DPCHCM
C
C***ROUTINES CALLED D1MACH
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 890209 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 DCHFMC to DCHFCM, 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 DCHFCM
C
C Fortran intrinsics used: DSIGN.
C Other routines used: D1MACH.
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 single precision version, simply:
C a. Change DCHFCM to CHFCM wherever it occurs,
C b. Change the double precision declarations to real, and
C c. Change the constants ZERO, ONE, ... to single precision.
C
C DECLARE ARGUMENTS.
C
DOUBLE PRECISION D1, D2, DELTA, D1MACH
C
C DECLARE LOCAL VARIABLES.
C
INTEGER ISMON, ITRUE
DOUBLE PRECISION 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.D0/, ONE/1.D0/, TWO/2.D0/, THREE/3.D0/, FOUR/4.D0/,
1 TEN /10.D0/
C
C MACHINE-DEPENDENT PARAMETER -- SHOULD BE ABOUT 10*UROUND.
C***FIRST EXECUTABLE STATEMENT DCHFCM
EPS = TEN*D1MACH(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 = DSIGN (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
DCHFCM = ISMON
RETURN
C------------- LAST LINE OF DCHFCM FOLLOWS -----------------------------
END
|
