dlapy2.f 2.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104
  1. *> \brief \b DLAPY2
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download DLAPY2 + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy2.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy2.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy2.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
  22. *
  23. * .. Scalar Arguments ..
  24. * DOUBLE PRECISION X, Y
  25. * ..
  26. *
  27. *
  28. *> \par Purpose:
  29. * =============
  30. *>
  31. *> \verbatim
  32. *>
  33. *> DLAPY2 returns sqrt(x**2+y**2), taking care not to cause unnecessary
  34. *> overflow.
  35. *> \endverbatim
  36. *
  37. * Arguments:
  38. * ==========
  39. *
  40. *> \param[in] X
  41. *> \verbatim
  42. *> X is DOUBLE PRECISION
  43. *> \endverbatim
  44. *>
  45. *> \param[in] Y
  46. *> \verbatim
  47. *> Y is DOUBLE PRECISION
  48. *> X and Y specify the values x and y.
  49. *> \endverbatim
  50. *
  51. * Authors:
  52. * ========
  53. *
  54. *> \author Univ. of Tennessee
  55. *> \author Univ. of California Berkeley
  56. *> \author Univ. of Colorado Denver
  57. *> \author NAG Ltd.
  58. *
  59. *> \date November 2011
  60. *
  61. *> \ingroup auxOTHERauxiliary
  62. *
  63. * =====================================================================
  64. DOUBLE PRECISION FUNCTION DLAPY2( X, Y )
  65. *
  66. * -- LAPACK auxiliary routine (version 3.4.0) --
  67. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  68. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  69. * November 2011
  70. *
  71. * .. Scalar Arguments ..
  72. DOUBLE PRECISION X, Y
  73. * ..
  74. *
  75. * =====================================================================
  76. *
  77. * .. Parameters ..
  78. DOUBLE PRECISION ZERO
  79. PARAMETER ( ZERO = 0.0D0 )
  80. DOUBLE PRECISION ONE
  81. PARAMETER ( ONE = 1.0D0 )
  82. * ..
  83. * .. Local Scalars ..
  84. DOUBLE PRECISION W, XABS, YABS, Z
  85. * ..
  86. * .. Intrinsic Functions ..
  87. INTRINSIC ABS, MAX, MIN, SQRT
  88. * ..
  89. * .. Executable Statements ..
  90. *
  91. XABS = ABS( X )
  92. YABS = ABS( Y )
  93. W = MAX( XABS, YABS )
  94. Z = MIN( XABS, YABS )
  95. IF( Z.EQ.ZERO ) THEN
  96. DLAPY2 = W
  97. ELSE
  98. DLAPY2 = W*SQRT( ONE+( Z / W )**2 )
  99. END IF
  100. RETURN
  101. *
  102. * End of DLAPY2
  103. *
  104. END