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

192 lines
5.1 KiB

  1. *> \brief \b SLAMCH
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * REAL FUNCTION SLAMCH( CMACH )
  12. *
  13. * .. Scalar Arguments ..
  14. * CHARACTER CMACH
  15. * ..
  16. *
  17. *
  18. *> \par Purpose:
  19. * =============
  20. *>
  21. *> \verbatim
  22. *>
  23. *> SLAMCH determines single precision machine parameters.
  24. *> \endverbatim
  25. *
  26. * Arguments:
  27. * ==========
  28. *
  29. *> \param[in] CMACH
  30. *> \verbatim
  31. *> Specifies the value to be returned by SLAMCH:
  32. *> = 'E' or 'e', SLAMCH := eps
  33. *> = 'S' or 's , SLAMCH := sfmin
  34. *> = 'B' or 'b', SLAMCH := base
  35. *> = 'P' or 'p', SLAMCH := eps*base
  36. *> = 'N' or 'n', SLAMCH := t
  37. *> = 'R' or 'r', SLAMCH := rnd
  38. *> = 'M' or 'm', SLAMCH := emin
  39. *> = 'U' or 'u', SLAMCH := rmin
  40. *> = 'L' or 'l', SLAMCH := emax
  41. *> = 'O' or 'o', SLAMCH := rmax
  42. *> where
  43. *> eps = relative machine precision
  44. *> sfmin = safe minimum, such that 1/sfmin does not overflow
  45. *> base = base of the machine
  46. *> prec = eps*base
  47. *> t = number of (base) digits in the mantissa
  48. *> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise
  49. *> emin = minimum exponent before (gradual) underflow
  50. *> rmin = underflow threshold - base**(emin-1)
  51. *> emax = largest exponent before overflow
  52. *> rmax = overflow threshold - (base**emax)*(1-eps)
  53. *> \endverbatim
  54. *
  55. * Authors:
  56. * ========
  57. *
  58. *> \author Univ. of Tennessee
  59. *> \author Univ. of California Berkeley
  60. *> \author Univ. of Colorado Denver
  61. *> \author NAG Ltd.
  62. *
  63. *> \date November 2011
  64. *
  65. *> \ingroup auxOTHERauxiliary
  66. *
  67. * =====================================================================
  68. REAL FUNCTION SLAMCH( CMACH )
  69. *
  70. * -- LAPACK auxiliary routine (version 3.4.0) --
  71. * -- LAPACK is a software package provided by Univ. of Tennessee, --
  72. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  73. * November 2011
  74. *
  75. * .. Scalar Arguments ..
  76. CHARACTER CMACH
  77. * ..
  78. *
  79. * =====================================================================
  80. *
  81. * .. Parameters ..
  82. REAL ONE, ZERO
  83. PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 )
  84. * ..
  85. * .. Local Scalars ..
  86. REAL 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. SLAMCH = RMACH
  143. RETURN
  144. *
  145. * End of SLAMCH
  146. *
  147. END
  148. ************************************************************************
  149. *> \brief \b SLAMC3
  150. *> \details
  151. *> \b Purpose:
  152. *> \verbatim
  153. *> SLAMC3 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. *> \endverbatim
  164. *>
  165. *> \param[in] B
  166. *> \verbatim
  167. *> The values A and B.
  168. *> \endverbatim
  169. *>
  170. *
  171. REAL FUNCTION SLAMC3( A, B )
  172. *
  173. * -- LAPACK auxiliary routine (version 3.4.0) --
  174. * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
  175. * November 2010
  176. *
  177. * .. Scalar Arguments ..
  178. REAL A, B
  179. * ..
  180. * =====================================================================
  181. *
  182. * .. Executable Statements ..
  183. *
  184. SLAMC3 = A + B
  185. *
  186. RETURN
  187. *
  188. * End of SLAMC3
  189. *
  190. END
  191. *
  192. ************************************************************************