dlamch.f 5.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189
  1. *> \brief \b DLAMCH
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * DOUBLE PRECISION FUNCTION DLAMCH( CMACH )
  12. *
  13. *
  14. *> \par Purpose:
  15. * =============
  16. *>
  17. *> \verbatim
  18. *>
  19. *> DLAMCH determines double precision machine parameters.
  20. *> \endverbatim
  21. *
  22. * Arguments:
  23. * ==========
  24. *
  25. *> \param[in] CMACH
  26. *> \verbatim
  27. *> Specifies the value to be returned by DLAMCH:
  28. *> = 'E' or 'e', DLAMCH := eps
  29. *> = 'S' or 's , DLAMCH := sfmin
  30. *> = 'B' or 'b', DLAMCH := base
  31. *> = 'P' or 'p', DLAMCH := eps*base
  32. *> = 'N' or 'n', DLAMCH := t
  33. *> = 'R' or 'r', DLAMCH := rnd
  34. *> = 'M' or 'm', DLAMCH := emin
  35. *> = 'U' or 'u', DLAMCH := rmin
  36. *> = 'L' or 'l', DLAMCH := emax
  37. *> = 'O' or 'o', DLAMCH := rmax
  38. *> where
  39. *> eps = relative machine precision
  40. *> sfmin = safe minimum, such that 1/sfmin does not overflow
  41. *> base = base of the machine
  42. *> prec = eps*base
  43. *> t = number of (base) digits in the mantissa
  44. *> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
  45. *> emin = minimum exponent before (gradual) underflow
  46. *> rmin = underflow threshold - base**(emin-1)
  47. *> emax = largest exponent before overflow
  48. *> rmax = overflow threshold - (base**emax)*(1-eps)
  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 DLAMCH( CMACH )
  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. CHARACTER CMACH
  73. * ..
  74. *
  75. * =====================================================================
  76. *
  77. * .. Parameters ..
  78. DOUBLE PRECISION ONE, ZERO
  79. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  80. * ..
  81. * .. Local Scalars ..
  82. DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
  83. * ..
  84. * .. External Functions ..
  85. LOGICAL LSAME
  86. EXTERNAL LSAME
  87. * ..
  88. * .. Intrinsic Functions ..
  89. INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
  90. $ MINEXPONENT, RADIX, TINY
  91. * ..
  92. * .. Executable Statements ..
  93. *
  94. *
  95. * Assume rounding, not chopping. Always.
  96. *
  97. RND = ONE
  98. *
  99. IF( ONE.EQ.RND ) THEN
  100. EPS = EPSILON(ZERO) * 0.5
  101. ELSE
  102. EPS = EPSILON(ZERO)
  103. END IF
  104. *
  105. IF( LSAME( CMACH, 'E' ) ) THEN
  106. RMACH = EPS
  107. ELSE IF( LSAME( CMACH, 'S' ) ) THEN
  108. SFMIN = TINY(ZERO)
  109. SMALL = ONE / HUGE(ZERO)
  110. IF( SMALL.GE.SFMIN ) THEN
  111. *
  112. * Use SMALL plus a bit, to avoid the possibility of rounding
  113. * causing overflow when computing 1/sfmin.
  114. *
  115. SFMIN = SMALL*( ONE+EPS )
  116. END IF
  117. RMACH = SFMIN
  118. ELSE IF( LSAME( CMACH, 'B' ) ) THEN
  119. RMACH = RADIX(ZERO)
  120. ELSE IF( LSAME( CMACH, 'P' ) ) THEN
  121. RMACH = EPS * RADIX(ZERO)
  122. ELSE IF( LSAME( CMACH, 'N' ) ) THEN
  123. RMACH = DIGITS(ZERO)
  124. ELSE IF( LSAME( CMACH, 'R' ) ) THEN
  125. RMACH = RND
  126. ELSE IF( LSAME( CMACH, 'M' ) ) THEN
  127. RMACH = MINEXPONENT(ZERO)
  128. ELSE IF( LSAME( CMACH, 'U' ) ) THEN
  129. RMACH = tiny(zero)
  130. ELSE IF( LSAME( CMACH, 'L' ) ) THEN
  131. RMACH = MAXEXPONENT(ZERO)
  132. ELSE IF( LSAME( CMACH, 'O' ) ) THEN
  133. RMACH = HUGE(ZERO)
  134. ELSE
  135. RMACH = ZERO
  136. END IF
  137. *
  138. DLAMCH = RMACH
  139. RETURN
  140. *
  141. * End of DLAMCH
  142. *
  143. END
  144. ************************************************************************
  145. *> \brief \b DLAMC3
  146. *> \details
  147. *> \b Purpose:
  148. *> \verbatim
  149. *> DLAMC3 is intended to force A and B to be stored prior to doing
  150. *> the addition of A and B , for use in situations where optimizers
  151. *> might hold one of these in a register.
  152. *> \endverbatim
  153. *> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
  154. *> \date November 2011
  155. *> \ingroup auxOTHERauxiliary
  156. *>
  157. *> \param[in] A
  158. *> \verbatim
  159. *> A is a DOUBLE PRECISION
  160. *> \endverbatim
  161. *>
  162. *> \param[in] B
  163. *> \verbatim
  164. *> B is a DOUBLE PRECISION
  165. *> The values A and B.
  166. *> \endverbatim
  167. *>
  168. DOUBLE PRECISION FUNCTION DLAMC3( A, B )
  169. *
  170. * -- LAPACK auxiliary routine (version 3.4.0) --
  171. * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  172. * November 2010
  173. *
  174. * .. Scalar Arguments ..
  175. DOUBLE PRECISION A, B
  176. * ..
  177. * =====================================================================
  178. *
  179. * .. Executable Statements ..
  180. *
  181. DLAMC3 = A + B
  182. *
  183. RETURN
  184. *
  185. * End of DLAMC3
  186. *
  187. END
  188. *
  189. ************************************************************************