slamch.f (5261B)
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 ************************************************************************