GNU Octave  3.8.0
A high-level interpreted language, primarily intended for numerical computations, mostly compatible with Matlab
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Properties Friends Macros Pages
pchst.f
Go to the documentation of this file.
1 *DECK PCHST
2  REAL FUNCTION pchst (ARG1, ARG2)
3 C***BEGIN PROLOGUE PCHST
4 C***SUBSIDIARY
5 C***PURPOSE PCHIP Sign-Testing Routine
6 C***LIBRARY SLATEC (PCHIP)
7 C***TYPE SINGLE PRECISION (PCHST-S, DPCHST-D)
8 C***AUTHOR Fritsch, F. N., (LLNL)
9 C***DESCRIPTION
10 C
11 C PCHST: PCHIP Sign-Testing Routine.
12 C
13 C Returns:
14 C -1. if ARG1 and ARG2 are of opposite sign.
15 C 0. if either argument is zero.
16 C +1. if ARG1 and ARG2 are of the same sign.
17 C
18 C The object is to do this without multiplying ARG1*ARG2, to avoid
19 C possible over/underflow problems.
20 C
21 C Fortran intrinsics used: SIGN.
22 C
23 C***SEE ALSO PCHCE, PCHCI, PCHCS, PCHIM
24 C***ROUTINES CALLED (NONE)
25 C***REVISION HISTORY (YYMMDD)
26 C 811103 DATE WRITTEN
27 C 820805 Converted to SLATEC library version.
28 C 870813 Minor cosmetic changes.
29 C 890411 Added SAVE statements (Vers. 3.2).
30 C 890411 REVISION DATE from Version 3.2
31 C 891214 Prologue converted to Version 4.0 format. (BAB)
32 C 900328 Added TYPE section. (WRB)
33 C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB)
34 C 930503 Improved purpose. (FNF)
35 C***END PROLOGUE PCHST
36 C
37 C**End
38 C
39 C DECLARE ARGUMENTS.
40 C
41  REAL arg1, arg2
42 C
43 C DECLARE LOCAL VARIABLES.
44 C
45  REAL one, zero
46  SAVE zero, one
47  DATA zero /0./, one /1./
48 C
49 C PERFORM THE TEST.
50 C
51 C***FIRST EXECUTABLE STATEMENT PCHST
52  pchst = sign(one,arg1) * sign(one,arg2)
53  IF ((arg1.EQ.zero) .OR. (arg2.EQ.zero)) pchst = zero
54 C
55  RETURN
56 C------------- LAST LINE OF PCHST FOLLOWS ------------------------------
57  END