105 lines
		
	
	
		
			2.5 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			105 lines
		
	
	
		
			2.5 KiB
		
	
	
	
		
			Fortran
		
	
	
	
*> \brief \b DLAPY2 returns sqrt(x2+y2).
 | 
						|
*
 | 
						|
*  =========== DOCUMENTATION ===========
 | 
						|
*
 | 
						|
* Online html documentation available at
 | 
						|
*            http://www.netlib.org/lapack/explore-html/
 | 
						|
*
 | 
						|
*> \htmlonly
 | 
						|
*> Download DLAPY2 + dependencies
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy2.f">
 | 
						|
*> [TGZ]</a>
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy2.f">
 | 
						|
*> [ZIP]</a>
 | 
						|
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy2.f">
 | 
						|
*> [TXT]</a>
 | 
						|
*> \endhtmlonly
 | 
						|
*
 | 
						|
*  Definition:
 | 
						|
*  ===========
 | 
						|
*
 | 
						|
*       DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
 | 
						|
*
 | 
						|
*       .. Scalar Arguments ..
 | 
						|
*       DOUBLE PRECISION   X, Y
 | 
						|
*       ..
 | 
						|
*
 | 
						|
*
 | 
						|
*> \par Purpose:
 | 
						|
*  =============
 | 
						|
*>
 | 
						|
*> \verbatim
 | 
						|
*>
 | 
						|
*> DLAPY2 returns sqrt(x**2+y**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
 | 
						|
*>          X and Y specify the values x and y.
 | 
						|
*> \endverbatim
 | 
						|
*
 | 
						|
*  Authors:
 | 
						|
*  ========
 | 
						|
*
 | 
						|
*> \author Univ. of Tennessee
 | 
						|
*> \author Univ. of California Berkeley
 | 
						|
*> \author Univ. of Colorado Denver
 | 
						|
*> \author NAG Ltd.
 | 
						|
*
 | 
						|
*> \date December 2016
 | 
						|
*
 | 
						|
*> \ingroup OTHERauxiliary
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
      DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
 | 
						|
*
 | 
						|
*  -- LAPACK auxiliary routine (version 3.7.0) --
 | 
						|
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 | 
						|
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | 
						|
*     December 2016
 | 
						|
*
 | 
						|
*     .. Scalar Arguments ..
 | 
						|
      DOUBLE PRECISION   X, Y
 | 
						|
*     ..
 | 
						|
*
 | 
						|
*  =====================================================================
 | 
						|
*
 | 
						|
*     .. Parameters ..
 | 
						|
      DOUBLE PRECISION   ZERO
 | 
						|
      PARAMETER          ( ZERO = 0.0D0 )
 | 
						|
      DOUBLE PRECISION   ONE
 | 
						|
      PARAMETER          ( ONE = 1.0D0 )
 | 
						|
*     ..
 | 
						|
*     .. Local Scalars ..
 | 
						|
      DOUBLE PRECISION   W, XABS, YABS, Z
 | 
						|
*     ..
 | 
						|
*     .. Intrinsic Functions ..
 | 
						|
      INTRINSIC          ABS, MAX, MIN, SQRT
 | 
						|
*     ..
 | 
						|
*     .. Executable Statements ..
 | 
						|
*
 | 
						|
      XABS = ABS( X )
 | 
						|
      YABS = ABS( Y )
 | 
						|
      W = MAX( XABS, YABS )
 | 
						|
      Z = MIN( XABS, YABS )
 | 
						|
      IF( Z.EQ.ZERO ) THEN
 | 
						|
         DLAPY2 = W
 | 
						|
      ELSE
 | 
						|
         DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
 | 
						|
      END IF
 | 
						|
      RETURN
 | 
						|
*
 | 
						|
*     End of DLAPY2
 | 
						|
*
 | 
						|
      END
 |