112 lines
		
	
	
		
			2.7 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			112 lines
		
	
	
		
			2.7 KiB
		
	
	
	
		
			Fortran
		
	
	
	
*> \brief \b DLAPY3 returns sqrt(x2+y2+z2).
 | 
						|
*
 | 
						|
*  =========== DOCUMENTATION ===========
 | 
						|
*
 | 
						|
* Online html documentation available at 
 | 
						|
*            http://www.netlib.org/lapack/explore-html/ 
 | 
						|
*
 | 
						|
*> \htmlonly
 | 
						|
*> Download DLAPY3 + dependencies 
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy3.f"> 
 | 
						|
*> [TGZ]</a> 
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy3.f"> 
 | 
						|
*> [ZIP]</a> 
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy3.f"> 
 | 
						|
*> [TXT]</a>
 | 
						|
*> \endhtmlonly 
 | 
						|
*
 | 
						|
*  Definition:
 | 
						|
*  ===========
 | 
						|
*
 | 
						|
*       DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
 | 
						|
* 
 | 
						|
*       .. Scalar Arguments ..
 | 
						|
*       DOUBLE PRECISION   X, Y, Z
 | 
						|
*       ..
 | 
						|
*  
 | 
						|
*
 | 
						|
*> \par Purpose:
 | 
						|
*  =============
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
 | 
						|
*> unnecessary overflow.
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Arguments:
 | 
						|
*  ==========
 | 
						|
*
 | 
						|
*> \param[in] X
 | 
						|
*> \verbatim
 | 
						|
*>          X is DOUBLE PRECISION
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] Y
 | 
						|
*> \verbatim
 | 
						|
*>          Y is DOUBLE PRECISION
 | 
						|
*> \endverbatim
 | 
						|
*>
 | 
						|
*> \param[in] Z
 | 
						|
*> \verbatim
 | 
						|
*>          Z is DOUBLE PRECISION
 | 
						|
*>          X, Y and Z specify the values x, y and z.
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Authors:
 | 
						|
*  ========
 | 
						|
*
 | 
						|
*> \author Univ. of Tennessee 
 | 
						|
*> \author Univ. of California Berkeley 
 | 
						|
*> \author Univ. of Colorado Denver 
 | 
						|
*> \author NAG Ltd. 
 | 
						|
*
 | 
						|
*> \date September 2012
 | 
						|
*
 | 
						|
*> \ingroup auxOTHERauxiliary
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
      DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
 | 
						|
*
 | 
						|
*  -- LAPACK auxiliary routine (version 3.4.2) --
 | 
						|
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 | 
						|
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | 
						|
*     September 2012
 | 
						|
*
 | 
						|
*     .. Scalar Arguments ..
 | 
						|
      DOUBLE PRECISION   X, Y, Z
 | 
						|
*     ..
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
*
 | 
						|
*     .. Parameters ..
 | 
						|
      DOUBLE PRECISION   ZERO
 | 
						|
      PARAMETER          ( ZERO = 0.0D0 )
 | 
						|
*     ..
 | 
						|
*     .. Local Scalars ..
 | 
						|
      DOUBLE PRECISION   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.
 | 
						|
         DLAPY3 =  XABS + YABS + ZABS
 | 
						|
      ELSE
 | 
						|
         DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
 | 
						|
     $            ( ZABS / W )**2 )
 | 
						|
      END IF
 | 
						|
      RETURN
 | 
						|
*
 | 
						|
*     End of DLAPY3
 | 
						|
*
 | 
						|
      END
 |