julie
be91086043
Those are just cosmetic changes to update version number and various other minor change.
58 lines
1.4 KiB
FortranFixed
58 lines
1.4 KiB
FortranFixed
REAL FUNCTION SLAPY3( X, Y, Z )
|
|
*
|
|
* -- LAPACK auxiliary routine (version 3.2) --
|
|
* -- LAPACK is a software package provided by Univ. of Tennessee, --
|
|
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
|
|
* November 2006
|
|
*
|
|
* .. Scalar Arguments ..
|
|
REAL X, Y, Z
|
|
* ..
|
|
*
|
|
* Purpose
|
|
* =======
|
|
*
|
|
* SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
|
|
* unnecessary overflow.
|
|
*
|
|
* Arguments
|
|
* =========
|
|
*
|
|
* X (input) REAL
|
|
* Y (input) REAL
|
|
* Z (input) REAL
|
|
* X, Y and Z specify the values x, y and z.
|
|
*
|
|
* =====================================================================
|
|
*
|
|
* .. Parameters ..
|
|
REAL ZERO
|
|
PARAMETER ( ZERO = 0.0E0 )
|
|
* ..
|
|
* .. Local Scalars ..
|
|
REAL W, XABS, YABS, ZABS
|
|
* ..
|
|
* .. Intrinsic Functions ..
|
|
INTRINSIC ABS, MAX, SQRT
|
|
* ..
|
|
* .. Executable Statements ..
|
|
*
|
|
XABS = ABS( X )
|
|
YABS = ABS( Y )
|
|
ZABS = ABS( Z )
|
|
W = MAX( XABS, YABS, ZABS )
|
|
IF( W.EQ.ZERO ) THEN
|
|
* W can be zero for max(0,nan,0)
|
|
* adding all three entries together will make sure
|
|
* NaN will not disappear.
|
|
SLAPY3 = XABS + YABS + ZABS
|
|
ELSE
|
|
SLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
|
|
$ ( ZABS / W )**2 )
|
|
END IF
|
|
RETURN
|
|
*
|
|
* End of SLAPY3
|
|
*
|
|
END
|