LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ slamc2()

subroutine slamc2 ( integer  BETA,
integer  T,
logical  RND,
real  EPS,
integer  EMIN,
real  RMIN,
integer  EMAX,
real  RMAX 
)

SLAMC2

Purpose:

 SLAMC2 determines the machine parameters specified in its argument
 list.
Author
LAPACK is a software package provided by Univ. of Tennessee, Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..
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]EPS
          The smallest positive number such that
             fl( 1.0 - EPS ) .LT. 1.0,
          where fl denotes the computed value.
[out]EMIN
          The minimum exponent before (gradual) underflow occurs.
[out]RMIN
          The smallest normalized number for the machine, given by
          BASE**( EMIN - 1 ), where  BASE  is the floating point value
          of BETA.
[out]EMAX
          The maximum exponent before overflow occurs.
[out]RMAX
          The largest positive number for the machine, given by
          BASE**EMAX * ( 1 - EPS ), where  BASE  is the floating point
          value of BETA.

Further Details

  The computation of  EPS  is based on a routine PARANOIA by
  W. Kahan of the University of California at Berkeley.

Definition at line 417 of file slamchf77.f.

418 *
419 * -- LAPACK auxiliary routine --
420 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
421 *
422 * .. Scalar Arguments ..
423  LOGICAL RND
424  INTEGER BETA, EMAX, EMIN, T
425  REAL EPS, RMAX, RMIN
426 * ..
427 * =====================================================================
428 *
429 * .. Local Scalars ..
430  LOGICAL FIRST, IEEE, IWARN, LIEEE1, LRND
431  INTEGER GNMIN, GPMIN, I, LBETA, LEMAX, LEMIN, LT,
432  $ NGNMIN, NGPMIN
433  REAL A, B, C, HALF, LEPS, LRMAX, LRMIN, ONE, RBASE,
434  $ SIXTH, SMALL, THIRD, TWO, ZERO
435 * ..
436 * .. External Functions ..
437  REAL SLAMC3
438  EXTERNAL slamc3
439 * ..
440 * .. External Subroutines ..
441  EXTERNAL slamc1, slamc4, slamc5
442 * ..
443 * .. Intrinsic Functions ..
444  INTRINSIC abs, max, min
445 * ..
446 * .. Save statement ..
447  SAVE first, iwarn, lbeta, lemax, lemin, leps, lrmax,
448  $ lrmin, lt
449 * ..
450 * .. Data statements ..
451  DATA first / .true. / , iwarn / .false. /
452 * ..
453 * .. Executable Statements ..
454 *
455  IF( first ) THEN
456  zero = 0
457  one = 1
458  two = 2
459 *
460 * LBETA, LT, LRND, LEPS, LEMIN and LRMIN are the local values of
461 * BETA, T, RND, EPS, EMIN and RMIN.
462 *
463 * Throughout this routine we use the function SLAMC3 to ensure
464 * that relevant values are stored and not held in registers, or
465 * are not affected by optimizers.
466 *
467 * SLAMC1 returns the parameters LBETA, LT, LRND and LIEEE1.
468 *
469  CALL slamc1( lbeta, lt, lrnd, lieee1 )
470 *
471 * Start to find EPS.
472 *
473  b = lbeta
474  a = b**( -lt )
475  leps = a
476 *
477 * Try some tricks to see whether or not this is the correct EPS.
478 *
479  b = two / 3
480  half = one / 2
481  sixth = slamc3( b, -half )
482  third = slamc3( sixth, sixth )
483  b = slamc3( third, -half )
484  b = slamc3( b, sixth )
485  b = abs( b )
486  IF( b.LT.leps )
487  $ b = leps
488 *
489  leps = 1
490 *
491 *+ WHILE( ( LEPS.GT.B ).AND.( B.GT.ZERO ) )LOOP
492  10 CONTINUE
493  IF( ( leps.GT.b ) .AND. ( b.GT.zero ) ) THEN
494  leps = b
495  c = slamc3( half*leps, ( two**5 )*( leps**2 ) )
496  c = slamc3( half, -c )
497  b = slamc3( half, c )
498  c = slamc3( half, -b )
499  b = slamc3( half, c )
500  GO TO 10
501  END IF
502 *+ END WHILE
503 *
504  IF( a.LT.leps )
505  $ leps = a
506 *
507 * Computation of EPS complete.
508 *
509 * Now find EMIN. Let A = + or - 1, and + or - (1 + BASE**(-3)).
510 * Keep dividing A by BETA until (gradual) underflow occurs. This
511 * is detected when we cannot recover the previous A.
512 *
513  rbase = one / lbeta
514  small = one
515  DO 20 i = 1, 3
516  small = slamc3( small*rbase, zero )
517  20 CONTINUE
518  a = slamc3( one, small )
519  CALL slamc4( ngpmin, one, lbeta )
520  CALL slamc4( ngnmin, -one, lbeta )
521  CALL slamc4( gpmin, a, lbeta )
522  CALL slamc4( gnmin, -a, lbeta )
523  ieee = .false.
524 *
525  IF( ( ngpmin.EQ.ngnmin ) .AND. ( gpmin.EQ.gnmin ) ) THEN
526  IF( ngpmin.EQ.gpmin ) THEN
527  lemin = ngpmin
528 * ( Non twos-complement machines, no gradual underflow;
529 * e.g., VAX )
530  ELSE IF( ( gpmin-ngpmin ).EQ.3 ) THEN
531  lemin = ngpmin - 1 + lt
532  ieee = .true.
533 * ( Non twos-complement machines, with gradual underflow;
534 * e.g., IEEE standard followers )
535  ELSE
536  lemin = min( ngpmin, gpmin )
537 * ( A guess; no known machine )
538  iwarn = .true.
539  END IF
540 *
541  ELSE IF( ( ngpmin.EQ.gpmin ) .AND. ( ngnmin.EQ.gnmin ) ) THEN
542  IF( abs( ngpmin-ngnmin ).EQ.1 ) THEN
543  lemin = max( ngpmin, ngnmin )
544 * ( Twos-complement machines, no gradual underflow;
545 * e.g., CYBER 205 )
546  ELSE
547  lemin = min( ngpmin, ngnmin )
548 * ( A guess; no known machine )
549  iwarn = .true.
550  END IF
551 *
552  ELSE IF( ( abs( ngpmin-ngnmin ).EQ.1 ) .AND.
553  $ ( gpmin.EQ.gnmin ) ) THEN
554  IF( ( gpmin-min( ngpmin, ngnmin ) ).EQ.3 ) THEN
555  lemin = max( ngpmin, ngnmin ) - 1 + lt
556 * ( Twos-complement machines with gradual underflow;
557 * no known machine )
558  ELSE
559  lemin = min( ngpmin, ngnmin )
560 * ( A guess; no known machine )
561  iwarn = .true.
562  END IF
563 *
564  ELSE
565  lemin = min( ngpmin, ngnmin, gpmin, gnmin )
566 * ( A guess; no known machine )
567  iwarn = .true.
568  END IF
569  first = .false.
570 ***
571 * Comment out this if block if EMIN is ok
572  IF( iwarn ) THEN
573  first = .true.
574  WRITE( 6, fmt = 9999 )lemin
575  END IF
576 ***
577 *
578 * Assume IEEE arithmetic if we found denormalised numbers above,
579 * or if arithmetic seems to round in the IEEE style, determined
580 * in routine SLAMC1. A true IEEE machine should have both things
581 * true; however, faulty machines may have one or the other.
582 *
583  ieee = ieee .OR. lieee1
584 *
585 * Compute RMIN by successive division by BETA. We could compute
586 * RMIN as BASE**( EMIN - 1 ), but some machines underflow during
587 * this computation.
588 *
589  lrmin = 1
590  DO 30 i = 1, 1 - lemin
591  lrmin = slamc3( lrmin*rbase, zero )
592  30 CONTINUE
593 *
594 * Finally, call SLAMC5 to compute EMAX and RMAX.
595 *
596  CALL slamc5( lbeta, lt, lemin, ieee, lemax, lrmax )
597  END IF
598 *
599  beta = lbeta
600  t = lt
601  rnd = lrnd
602  eps = leps
603  emin = lemin
604  rmin = lrmin
605  emax = lemax
606  rmax = lrmax
607 *
608  RETURN
609 *
610  9999 FORMAT( / / ' WARNING. The value EMIN may be incorrect:-',
611  $ ' EMIN = ', i8, /
612  $ ' If, after inspection, the value EMIN looks',
613  $ ' acceptable please comment out ',
614  $ / ' the IF block as marked within the code of routine',
615  $ ' SLAMC2,', / ' otherwise supply EMIN explicitly.', / )
616 *
617 * End of SLAMC2
618 *
real function slamc3(A, B)
SLAMC3
Definition: slamch.f:169
subroutine slamc1(BETA, T, RND, IEEE1)
SLAMC1
Definition: slamchf77.f:207
subroutine slamc5(BETA, P, EMIN, IEEE, EMAX, RMAX)
SLAMC5
Definition: slamchf77.f:793
subroutine slamc4(EMIN, START, BASE)
SLAMC4
Definition: slamchf77.f:686
Here is the call graph for this function:
Here is the caller graph for this function: