 LAPACK  3.8.0 LAPACK: Linear Algebra PACKage

## ◆ slamc1()

 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.7.0) --
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: