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

SLAMC1

Purpose:

SLAMC1 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.
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 211 of file slamchf77.f.

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

Here is the caller graph for this function: