Mercurial > hg > octave-nkf
diff libcruft/slatec-fn/pchst.f @ 7789:82be108cc558
First attempt at single precision tyeps
* * *
corrections to qrupdate single precision routines
* * *
prefer demotion to single over promotion to double
* * *
Add single precision support to log2 function
* * *
Trivial PROJECT file update
* * *
Cache optimized hermitian/transpose methods
* * *
Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author | David Bateman <dbateman@free.fr> |
---|---|
date | Sun, 27 Apr 2008 22:34:17 +0200 |
parents | |
children |
line wrap: on
line diff
new file mode 100644 --- /dev/null +++ b/libcruft/slatec-fn/pchst.f @@ -0,0 +1,57 @@ +*DECK PCHST + REAL FUNCTION PCHST (ARG1, ARG2) +C***BEGIN PROLOGUE PCHST +C***SUBSIDIARY +C***PURPOSE PCHIP Sign-Testing Routine +C***LIBRARY SLATEC (PCHIP) +C***TYPE SINGLE PRECISION (PCHST-S, DPCHST-D) +C***AUTHOR Fritsch, F. N., (LLNL) +C***DESCRIPTION +C +C PCHST: PCHIP Sign-Testing Routine. +C +C Returns: +C -1. if ARG1 and ARG2 are of opposite sign. +C 0. if either argument is zero. +C +1. if ARG1 and ARG2 are of the same sign. +C +C The object is to do this without multiplying ARG1*ARG2, to avoid +C possible over/underflow problems. +C +C Fortran intrinsics used: SIGN. +C +C***SEE ALSO PCHCE, PCHCI, PCHCS, PCHIM +C***ROUTINES CALLED (NONE) +C***REVISION HISTORY (YYMMDD) +C 811103 DATE WRITTEN +C 820805 Converted to SLATEC library version. +C 870813 Minor cosmetic changes. +C 890411 Added SAVE statements (Vers. 3.2). +C 890411 REVISION DATE from Version 3.2 +C 891214 Prologue converted to Version 4.0 format. (BAB) +C 900328 Added TYPE section. (WRB) +C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB) +C 930503 Improved purpose. (FNF) +C***END PROLOGUE PCHST +C +C**End +C +C DECLARE ARGUMENTS. +C + REAL ARG1, ARG2 +C +C DECLARE LOCAL VARIABLES. +C + REAL ONE, ZERO + SAVE ZERO, ONE + DATA ZERO /0./, ONE /1./ +C +C PERFORM THE TEST. +C +C***FIRST EXECUTABLE STATEMENT PCHST + PCHST = SIGN(ONE,ARG1) * SIGN(ONE,ARG2) + IF ((ARG1.EQ.ZERO) .OR. (ARG2.EQ.ZERO)) PCHST = ZERO +C + RETURN +C------------- LAST LINE OF PCHST FOLLOWS ------------------------------ + END