00001 *DECK DPCHST 00002 DOUBLE PRECISION FUNCTION DPCHST (ARG1, ARG2) 00003 C***BEGIN PROLOGUE DPCHST 00004 C***SUBSIDIARY 00005 C***PURPOSE DPCHIP Sign-Testing Routine 00006 C***LIBRARY SLATEC (PCHIP) 00007 C***TYPE DOUBLE PRECISION (PCHST-S, DPCHST-D) 00008 C***AUTHOR Fritsch, F. N., (LLNL) 00009 C***DESCRIPTION 00010 C 00011 C DPCHST: DPCHIP Sign-Testing Routine. 00012 C 00013 C 00014 C Returns: 00015 C -1. if ARG1 and ARG2 are of opposite sign. 00016 C 0. if either argument is zero. 00017 C +1. if ARG1 and ARG2 are of the same sign. 00018 C 00019 C The object is to do this without multiplying ARG1*ARG2, to avoid 00020 C possible over/underflow problems. 00021 C 00022 C Fortran intrinsics used: SIGN. 00023 C 00024 C***SEE ALSO DPCHCE, DPCHCI, DPCHCS, DPCHIM 00025 C***ROUTINES CALLED (NONE) 00026 C***REVISION HISTORY (YYMMDD) 00027 C 811103 DATE WRITTEN 00028 C 820805 Converted to SLATEC library version. 00029 C 870813 Minor cosmetic changes. 00030 C 890411 Added SAVE statements (Vers. 3.2). 00031 C 890531 Changed all specific intrinsics to generic. (WRB) 00032 C 890531 REVISION DATE from Version 3.2 00033 C 891214 Prologue converted to Version 4.0 format. (BAB) 00034 C 900328 Added TYPE section. (WRB) 00035 C 910408 Updated AUTHOR and DATE WRITTEN sections in prologue. (WRB) 00036 C 930503 Improved purpose. (FNF) 00037 C***END PROLOGUE DPCHST 00038 C 00039 C**End 00040 C 00041 C DECLARE ARGUMENTS. 00042 C 00043 DOUBLE PRECISION ARG1, ARG2 00044 C 00045 C DECLARE LOCAL VARIABLES. 00046 C 00047 DOUBLE PRECISION ONE, ZERO 00048 SAVE ZERO, ONE 00049 DATA ZERO /0.D0/, ONE/1.D0/ 00050 C 00051 C PERFORM THE TEST. 00052 C 00053 C***FIRST EXECUTABLE STATEMENT DPCHST 00054 DPCHST = SIGN(ONE,ARG1) * SIGN(ONE,ARG2) 00055 IF ((ARG1.EQ.ZERO) .OR. (ARG2.EQ.ZERO)) DPCHST = ZERO 00056 C 00057 RETURN 00058 C------------- LAST LINE OF DPCHST FOLLOWS ----------------------------- 00059 END
1.7.1
