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.

dlamch.f 5.3 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193
  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. * .. Scalar Arguments ..
  76. DOUBLE PRECISION A, B
  77. * ..
  78. *
  79. * =====================================================================
  80. *
  81. * .. Parameters ..
  82. DOUBLE PRECISION ONE, ZERO
  83. PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
  84. * ..
  85. * .. Local Scalars ..
  86. DOUBLE PRECISION RND, EPS, SFMIN, SMALL, RMACH
  87. * ..
  88. * .. External Functions ..
  89. LOGICAL LSAME
  90. EXTERNAL LSAME
  91. * ..
  92. * .. Intrinsic Functions ..
  93. INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT,
  94. $ MINEXPONENT, RADIX, TINY
  95. * ..
  96. * .. Executable Statements ..
  97. *
  98. *
  99. * Assume rounding, not chopping. Always.
  100. *
  101. RND = ONE
  102. *
  103. IF( ONE.EQ.RND ) THEN
  104. EPS = EPSILON(ZERO) * 0.5
  105. ELSE
  106. EPS = EPSILON(ZERO)
  107. END IF
  108. *
  109. IF( LSAME( CMACH, 'E' ) ) THEN
  110. RMACH = EPS
  111. ELSE IF( LSAME( CMACH, 'S' ) ) THEN
  112. SFMIN = TINY(ZERO)
  113. SMALL = ONE / HUGE(ZERO)
  114. IF( SMALL.GE.SFMIN ) THEN
  115. *
  116. * Use SMALL plus a bit, to avoid the possibility of rounding
  117. * causing overflow when computing 1/sfmin.
  118. *
  119. SFMIN = SMALL*( ONE+EPS )
  120. END IF
  121. RMACH = SFMIN
  122. ELSE IF( LSAME( CMACH, 'B' ) ) THEN
  123. RMACH = RADIX(ZERO)
  124. ELSE IF( LSAME( CMACH, 'P' ) ) THEN
  125. RMACH = EPS * RADIX(ZERO)
  126. ELSE IF( LSAME( CMACH, 'N' ) ) THEN
  127. RMACH = DIGITS(ZERO)
  128. ELSE IF( LSAME( CMACH, 'R' ) ) THEN
  129. RMACH = RND
  130. ELSE IF( LSAME( CMACH, 'M' ) ) THEN
  131. RMACH = MINEXPONENT(ZERO)
  132. ELSE IF( LSAME( CMACH, 'U' ) ) THEN
  133. RMACH = tiny(zero)
  134. ELSE IF( LSAME( CMACH, 'L' ) ) THEN
  135. RMACH = MAXEXPONENT(ZERO)
  136. ELSE IF( LSAME( CMACH, 'O' ) ) THEN
  137. RMACH = HUGE(ZERO)
  138. ELSE
  139. RMACH = ZERO
  140. END IF
  141. *
  142. DLAMCH = RMACH
  143. RETURN
  144. *
  145. * End of DLAMCH
  146. *
  147. END
  148. ************************************************************************
  149. *> \brief \b DLAMC3
  150. *> \details
  151. *> \b Purpose:
  152. *> \verbatim
  153. *> DLAMC3 is intended to force A and B to be stored prior to doing
  154. *> the addition of A and B , for use in situations where optimizers
  155. *> might hold one of these in a register.
  156. *> \endverbatim
  157. *> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
  158. *> \date November 2011
  159. *> \ingroup auxOTHERauxiliary
  160. *>
  161. *> \param[in] A
  162. *> \verbatim
  163. *> A is a DOUBLE PRECISION
  164. *> \endverbatim
  165. *>
  166. *> \param[in] B
  167. *> \verbatim
  168. *> B is a DOUBLE PRECISION
  169. *> The values A and B.
  170. *> \endverbatim
  171. *>
  172. DOUBLE PRECISION FUNCTION DLAMC3( A, B )
  173. *
  174. * -- LAPACK auxiliary routine (version 3.4.0) --
  175. * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  176. * November 2010
  177. *
  178. * .. Scalar Arguments ..
  179. DOUBLE PRECISION A, B
  180. * ..
  181. * =====================================================================
  182. *
  183. * .. Executable Statements ..
  184. *
  185. DLAMC3 = A + B
  186. *
  187. RETURN
  188. *
  189. * End of DLAMC3
  190. *
  191. END
  192. *
  193. ************************************************************************