You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

dlapy3.f 2.8 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112
  1. *> \brief \b DLAPY3 returns sqrt(x2+y2+z2).
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download DLAPY3 + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlapy3.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlapy3.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlapy3.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
  22. *
  23. * .. Scalar Arguments ..
  24. * DOUBLE PRECISION X, Y, Z
  25. * ..
  26. *
  27. *
  28. *> \par Purpose:
  29. * =============
  30. *>
  31. *> \verbatim
  32. *>
  33. *> DLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
  34. *> unnecessary overflow and unnecessary underflow.
  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. *> \endverbatim
  49. *>
  50. *> \param[in] Z
  51. *> \verbatim
  52. *> Z is DOUBLE PRECISION
  53. *> X, Y and Z specify the values x, y and z.
  54. *> \endverbatim
  55. *
  56. * Authors:
  57. * ========
  58. *
  59. *> \author Univ. of Tennessee
  60. *> \author Univ. of California Berkeley
  61. *> \author Univ. of Colorado Denver
  62. *> \author NAG Ltd.
  63. *
  64. *> \ingroup OTHERauxiliary
  65. *
  66. * =====================================================================
  67. DOUBLE PRECISION FUNCTION DLAPY3( X, Y, Z )
  68. *
  69. * -- LAPACK auxiliary routine --
  70. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  71. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  72. *
  73. * .. Scalar Arguments ..
  74. DOUBLE PRECISION X, Y, Z
  75. * ..
  76. *
  77. * =====================================================================
  78. *
  79. * .. Parameters ..
  80. DOUBLE PRECISION ZERO
  81. PARAMETER ( ZERO = 0.0D0 )
  82. * ..
  83. * .. Local Scalars ..
  84. DOUBLE PRECISION W, XABS, YABS, ZABS, HUGEVAL
  85. * ..
  86. * .. External Subroutines ..
  87. DOUBLE PRECISION DLAMCH
  88. * ..
  89. * .. Intrinsic Functions ..
  90. INTRINSIC ABS, MAX, SQRT
  91. * ..
  92. * .. Executable Statements ..
  93. *
  94. HUGEVAL = DLAMCH( 'Overflow' )
  95. XABS = ABS( X )
  96. YABS = ABS( Y )
  97. ZABS = ABS( Z )
  98. W = MAX( XABS, YABS, ZABS )
  99. IF( W.EQ.ZERO .OR. W.GT.HUGEVAL ) THEN
  100. * W can be zero for max(0,nan,0)
  101. * adding all three entries together will make sure
  102. * NaN will not disappear.
  103. DLAPY3 = XABS + YABS + ZABS
  104. ELSE
  105. DLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
  106. $ ( ZABS / W )**2 )
  107. END IF
  108. RETURN
  109. *
  110. * End of DLAPY3
  111. *
  112. END