LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dlamc1 ( integer  BETA,
integer  T,
logical  RND,
logical  IEEE1 
)

DLAMC1

Purpose:

 DLAMC1 determines the machine parameters given by BETA, T, RND, and
 IEEE1.
Parameters
[out]BETA
          The base of the machine.
[out]T
          The number of ( BETA ) digits in the mantissa.
[out]RND
          Specifies whether proper rounding  ( RND = .TRUE. )  or
          chopping  ( RND = .FALSE. )  occurs in addition. This may not
          be a reliable guide to the way in which the machine performs
          its arithmetic.
[out]IEEE1
          Specifies whether rounding appears to be done in the IEEE
          'round to nearest' style.
Author
LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
Date
April 2012

Further Details

  The routine is based on the routine  ENVRON  by Malcolm and
  incorporates suggestions by Gentleman and Marovich. See

     Malcolm M. A. (1972) Algorithms to reveal properties of
        floating-point arithmetic. Comms. of the ACM, 15, 949-951.

     Gentleman W. M. and Marovich S. B. (1974) More on algorithms
        that reveal properties of floating point arithmetic units.
        Comms. of the ACM, 17, 276-277.

Definition at line 207 of file dlamchf77.f.

207 *
208 * -- LAPACK auxiliary routine (version 3.4.1) --
209 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
210 * November 2010
211 *
212 * .. Scalar Arguments ..
213  LOGICAL ieee1, rnd
214  INTEGER beta, t
215 * ..
216 * =====================================================================
217 *
218 * .. Local Scalars ..
219  LOGICAL first, lieee1, lrnd
220  INTEGER lbeta, lt
221  DOUBLE PRECISION a, b, c, f, one, qtr, savec, t1, t2
222 * ..
223 * .. External Functions ..
224  DOUBLE PRECISION dlamc3
225  EXTERNAL dlamc3
226 * ..
227 * .. Save statement ..
228  SAVE first, lieee1, lbeta, lrnd, lt
229 * ..
230 * .. Data statements ..
231  DATA first / .true. /
232 * ..
233 * .. Executable Statements ..
234 *
235  IF( first ) THEN
236  one = 1
237 *
238 * LBETA, LIEEE1, LT and LRND are the local values of BETA,
239 * IEEE1, T and RND.
240 *
241 * Throughout this routine we use the function DLAMC3 to ensure
242 * that relevant values are stored and not held in registers, or
243 * are not affected by optimizers.
244 *
245 * Compute a = 2.0**m with the smallest positive integer m such
246 * that
247 *
248 * fl( a + 1.0 ) = a.
249 *
250  a = 1
251  c = 1
252 *
253 *+ WHILE( C.EQ.ONE )LOOP
254  10 CONTINUE
255  IF( c.EQ.one ) THEN
256  a = 2*a
257  c = dlamc3( a, one )
258  c = dlamc3( c, -a )
259  GO TO 10
260  END IF
261 *+ END WHILE
262 *
263 * Now compute b = 2.0**m with the smallest positive integer m
264 * such that
265 *
266 * fl( a + b ) .gt. a.
267 *
268  b = 1
269  c = dlamc3( a, b )
270 *
271 *+ WHILE( C.EQ.A )LOOP
272  20 CONTINUE
273  IF( c.EQ.a ) THEN
274  b = 2*b
275  c = dlamc3( a, b )
276  GO TO 20
277  END IF
278 *+ END WHILE
279 *
280 * Now compute the base. a and c are neighbouring floating point
281 * numbers in the interval ( beta**t, beta**( t + 1 ) ) and so
282 * their difference is beta. Adding 0.25 to c is to ensure that it
283 * is truncated to beta and not ( beta - 1 ).
284 *
285  qtr = one / 4
286  savec = c
287  c = dlamc3( c, -a )
288  lbeta = c + qtr
289 *
290 * Now determine whether rounding or chopping occurs, by adding a
291 * bit less than beta/2 and a bit more than beta/2 to a.
292 *
293  b = lbeta
294  f = dlamc3( b / 2, -b / 100 )
295  c = dlamc3( f, a )
296  IF( c.EQ.a ) THEN
297  lrnd = .true.
298  ELSE
299  lrnd = .false.
300  END IF
301  f = dlamc3( b / 2, b / 100 )
302  c = dlamc3( f, a )
303  IF( ( lrnd ) .AND. ( c.EQ.a ) )
304  $ lrnd = .false.
305 *
306 * Try and decide whether rounding is done in the IEEE 'round to
307 * nearest' style. B/2 is half a unit in the last place of the two
308 * numbers A and SAVEC. Furthermore, A is even, i.e. has last bit
309 * zero, and SAVEC is odd. Thus adding B/2 to A should not change
310 * A, but adding B/2 to SAVEC should change SAVEC.
311 *
312  t1 = dlamc3( b / 2, a )
313  t2 = dlamc3( b / 2, savec )
314  lieee1 = ( t1.EQ.a ) .AND. ( t2.GT.savec ) .AND. lrnd
315 *
316 * Now find the mantissa, t. It should be the integer part of
317 * log to the base beta of a, however it is safer to determine t
318 * by powering. So we find t as the smallest positive integer for
319 * which
320 *
321 * fl( beta**t + 1.0 ) = 1.0.
322 *
323  lt = 0
324  a = 1
325  c = 1
326 *
327 *+ WHILE( C.EQ.ONE )LOOP
328  30 CONTINUE
329  IF( c.EQ.one ) THEN
330  lt = lt + 1
331  a = a*lbeta
332  c = dlamc3( a, one )
333  c = dlamc3( c, -a )
334  GO TO 30
335  END IF
336 *+ END WHILE
337 *
338  END IF
339 *
340  beta = lbeta
341  t = lt
342  rnd = lrnd
343  ieee1 = lieee1
344  first = .false.
345  RETURN
346 *
347 * End of DLAMC1
348 *
double precision function dlamc3(A, B)
DLAMC3
Definition: dlamch.f:169

Here is the caller graph for this function: