LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ dlamc2()

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.
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 418 of file dlamchf77.f.

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