![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLAMCH 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * REAL FUNCTION SLAMCH( CMACH ) 00012 * 00013 * .. Scalar Arguments .. 00014 * CHARACTER CMACH 00015 * .. 00016 * 00017 * 00018 *> \par Purpose: 00019 * ============= 00020 *> 00021 *> \verbatim 00022 *> 00023 *> SLAMCH determines single precision machine parameters. 00024 *> \endverbatim 00025 * 00026 * Arguments: 00027 * ========== 00028 * 00029 *> \param[in] CMACH 00030 *> \verbatim 00031 *> Specifies the value to be returned by SLAMCH: 00032 *> = 'E' or 'e', SLAMCH := eps 00033 *> = 'S' or 's , SLAMCH := sfmin 00034 *> = 'B' or 'b', SLAMCH := base 00035 *> = 'P' or 'p', SLAMCH := eps*base 00036 *> = 'N' or 'n', SLAMCH := t 00037 *> = 'R' or 'r', SLAMCH := rnd 00038 *> = 'M' or 'm', SLAMCH := emin 00039 *> = 'U' or 'u', SLAMCH := rmin 00040 *> = 'L' or 'l', SLAMCH := emax 00041 *> = 'O' or 'o', SLAMCH := rmax 00042 *> where 00043 *> eps = relative machine precision 00044 *> sfmin = safe minimum, such that 1/sfmin does not overflow 00045 *> base = base of the machine 00046 *> prec = eps*base 00047 *> t = number of (base) digits in the mantissa 00048 *> rnd = 1.0 when rounding occurs in addition, 0.0 otherwise 00049 *> emin = minimum exponent before (gradual) underflow 00050 *> rmin = underflow threshold - base**(emin-1) 00051 *> emax = largest exponent before overflow 00052 *> rmax = overflow threshold - (base**emax)*(1-eps) 00053 *> \endverbatim 00054 * 00055 * Authors: 00056 * ======== 00057 * 00058 *> \author Univ. of Tennessee 00059 *> \author Univ. of California Berkeley 00060 *> \author Univ. of Colorado Denver 00061 *> \author NAG Ltd. 00062 * 00063 *> \date November 2011 00064 * 00065 *> \ingroup auxOTHERauxiliary 00066 * 00067 * ===================================================================== 00068 REAL FUNCTION SLAMCH( CMACH ) 00069 * 00070 * -- LAPACK auxiliary routine (version 3.4.0) -- 00071 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00072 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00073 * November 2011 00074 * 00075 * .. Scalar Arguments .. 00076 CHARACTER CMACH 00077 * .. 00078 * 00079 * ===================================================================== 00080 * 00081 * .. Parameters .. 00082 REAL ONE, ZERO 00083 PARAMETER ( ONE = 1.0E+0, ZERO = 0.0E+0 ) 00084 * .. 00085 * .. Local Scalars .. 00086 REAL RND, EPS, SFMIN, SMALL, RMACH 00087 * .. 00088 * .. External Functions .. 00089 LOGICAL LSAME 00090 EXTERNAL LSAME 00091 * .. 00092 * .. Intrinsic Functions .. 00093 INTRINSIC DIGITS, EPSILON, HUGE, MAXEXPONENT, 00094 $ MINEXPONENT, RADIX, TINY 00095 * .. 00096 * .. Executable Statements .. 00097 * 00098 * 00099 * Assume rounding, not chopping. Always. 00100 * 00101 RND = ONE 00102 * 00103 IF( ONE.EQ.RND ) THEN 00104 EPS = EPSILON(ZERO) * 0.5 00105 ELSE 00106 EPS = EPSILON(ZERO) 00107 END IF 00108 * 00109 IF( LSAME( CMACH, 'E' ) ) THEN 00110 RMACH = EPS 00111 ELSE IF( LSAME( CMACH, 'S' ) ) THEN 00112 SFMIN = TINY(ZERO) 00113 SMALL = ONE / HUGE(ZERO) 00114 IF( SMALL.GE.SFMIN ) THEN 00115 * 00116 * Use SMALL plus a bit, to avoid the possibility of rounding 00117 * causing overflow when computing 1/sfmin. 00118 * 00119 SFMIN = SMALL*( ONE+EPS ) 00120 END IF 00121 RMACH = SFMIN 00122 ELSE IF( LSAME( CMACH, 'B' ) ) THEN 00123 RMACH = RADIX(ZERO) 00124 ELSE IF( LSAME( CMACH, 'P' ) ) THEN 00125 RMACH = EPS * RADIX(ZERO) 00126 ELSE IF( LSAME( CMACH, 'N' ) ) THEN 00127 RMACH = DIGITS(ZERO) 00128 ELSE IF( LSAME( CMACH, 'R' ) ) THEN 00129 RMACH = RND 00130 ELSE IF( LSAME( CMACH, 'M' ) ) THEN 00131 RMACH = MINEXPONENT(ZERO) 00132 ELSE IF( LSAME( CMACH, 'U' ) ) THEN 00133 RMACH = tiny(zero) 00134 ELSE IF( LSAME( CMACH, 'L' ) ) THEN 00135 RMACH = MAXEXPONENT(ZERO) 00136 ELSE IF( LSAME( CMACH, 'O' ) ) THEN 00137 RMACH = HUGE(ZERO) 00138 ELSE 00139 RMACH = ZERO 00140 END IF 00141 * 00142 SLAMCH = RMACH 00143 RETURN 00144 * 00145 * End of SLAMCH 00146 * 00147 END 00148 ************************************************************************ 00149 *> \brief \b SLAMC3 00150 *> \details 00151 *> \b Purpose: 00152 *> \verbatim 00153 *> SLAMC3 is intended to force A and B to be stored prior to doing 00154 *> the addition of A and B , for use in situations where optimizers 00155 *> might hold one of these in a register. 00156 *> \endverbatim 00157 *> \author LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd.. 00158 *> \date November 2011 00159 *> \ingroup auxOTHERauxiliary 00160 *> 00161 *> \param[in] A 00162 *> \verbatim 00163 *> \endverbatim 00164 *> 00165 *> \param[in] B 00166 *> \verbatim 00167 *> The values A and B. 00168 *> \endverbatim 00169 *> 00170 * 00171 REAL FUNCTION SLAMC3( A, B ) 00172 * 00173 * -- LAPACK auxiliary routine (version 3.4.0) -- 00174 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00175 * November 2010 00176 * 00177 * .. Scalar Arguments .. 00178 REAL A, B 00179 * .. 00180 * ===================================================================== 00181 * 00182 * .. Executable Statements .. 00183 * 00184 SLAMC3 = A + B 00185 * 00186 RETURN 00187 * 00188 * End of SLAMC3 00189 * 00190 END 00191 * 00192 ************************************************************************