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.4 kB

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