LAPACK  3.6.1 LAPACK: Linear Algebra PACKage
 subroutine dlamc2 ( integer BETA, integer T, logical RND, double precision EPS, integer EMIN, double precision RMIN, integer EMAX, double precision RMAX )

DLAMC2

Purpose:

``` DLAMC2 determines the machine parameters specified in its argument
list.```
Date
April 2012
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 420 of file dlamchf77.f.

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

Here is the call graph for this function: