LAPACK  3.10.1
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.
Author
LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..

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

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