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