slapy3.f 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111
  1. *> \brief \b SLAPY3
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. *> \htmlonly
  9. *> Download SLAPY3 + dependencies
  10. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slapy3.f">
  11. *> [TGZ]</a>
  12. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slapy3.f">
  13. *> [ZIP]</a>
  14. *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slapy3.f">
  15. *> [TXT]</a>
  16. *> \endhtmlonly
  17. *
  18. * Definition:
  19. * ===========
  20. *
  21. * REAL FUNCTION SLAPY3( X, Y, Z )
  22. *
  23. * .. Scalar Arguments ..
  24. * REAL X, Y, Z
  25. * ..
  26. *
  27. *
  28. *> \par Purpose:
  29. * =============
  30. *>
  31. *> \verbatim
  32. *>
  33. *> SLAPY3 returns sqrt(x**2+y**2+z**2), taking care not to cause
  34. *> unnecessary overflow.
  35. *> \endverbatim
  36. *
  37. * Arguments:
  38. * ==========
  39. *
  40. *> \param[in] X
  41. *> \verbatim
  42. *> X is REAL
  43. *> \endverbatim
  44. *>
  45. *> \param[in] Y
  46. *> \verbatim
  47. *> Y is REAL
  48. *> \endverbatim
  49. *>
  50. *> \param[in] Z
  51. *> \verbatim
  52. *> Z is REAL
  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. *> \date November 2011
  65. *
  66. *> \ingroup auxOTHERauxiliary
  67. *
  68. * =====================================================================
  69. REAL FUNCTION SLAPY3( X, Y, Z )
  70. *
  71. * -- LAPACK auxiliary routine (version 3.4.0) --
  72. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  73. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  74. * November 2011
  75. *
  76. * .. Scalar Arguments ..
  77. REAL X, Y, Z
  78. * ..
  79. *
  80. * =====================================================================
  81. *
  82. * .. Parameters ..
  83. REAL ZERO
  84. PARAMETER ( ZERO = 0.0E0 )
  85. * ..
  86. * .. Local Scalars ..
  87. REAL W, XABS, YABS, ZABS
  88. * ..
  89. * .. Intrinsic Functions ..
  90. INTRINSIC ABS, MAX, SQRT
  91. * ..
  92. * .. Executable Statements ..
  93. *
  94. XABS = ABS( X )
  95. YABS = ABS( Y )
  96. ZABS = ABS( Z )
  97. W = MAX( XABS, YABS, ZABS )
  98. IF( W.EQ.ZERO ) THEN
  99. * W can be zero for max(0,nan,0)
  100. * adding all three entries together will make sure
  101. * NaN will not disappear.
  102. SLAPY3 = XABS + YABS + ZABS
  103. ELSE
  104. SLAPY3 = W*SQRT( ( XABS / W )**2+( YABS / W )**2+
  105. $ ( ZABS / W )**2 )
  106. END IF
  107. RETURN
  108. *
  109. * End of SLAPY3
  110. *
  111. END