LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine slamc4 ( integer  EMIN,
real  START,
integer  BASE 
)

SLAMC4

Purpose: 

 SLAMC4 is a service routine for SLAMC2.
Parameters
[out]EMIN
          The minimum exponent before (gradual) underflow, computed by
          setting A = START and dividing by BASE until the previous A
          can not be recovered.
[in]START
          The starting point for determining EMIN.
[in]BASE
          The base of the machine.

Definition at line 694 of file slamchf77.f.

694 *
695 * -- LAPACK auxiliary routine (version 3.4.1) --
696 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
697 * November 2010
698 *
699 * .. Scalar Arguments ..
700  INTEGER base
701  INTEGER emin
702  REAL start
703 * ..
704 * =====================================================================
705 *
706 * .. Local Scalars ..
707  INTEGER i
708  REAL a, b1, b2, c1, c2, d1, d2, one, rbase, zero
709 * ..
710 * .. External Functions ..
711  REAL slamc3
712  EXTERNAL slamc3
713 * ..
714 * .. Executable Statements ..
715 *
716  a = start
717  one = 1
718  rbase = one / base
719  zero = 0
720  emin = 1
721  b1 = slamc3( a*rbase, zero )
722  c1 = a
723  c2 = a
724  d1 = a
725  d2 = a
726 *+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
727 * $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP
728  10 CONTINUE
729  IF( ( c1.EQ.a ) .AND. ( c2.EQ.a ) .AND. ( d1.EQ.a ) .AND.
730  $ ( d2.EQ.a ) ) THEN
731  emin = emin - 1
732  a = b1
733  b1 = slamc3( a / base, zero )
734  c1 = slamc3( b1*base, zero )
735  d1 = zero
736  DO 20 i = 1, base
737  d1 = d1 + b1
738  20 CONTINUE
739  b2 = slamc3( a*rbase, zero )
740  c2 = slamc3( b2 / rbase, zero )
741  d2 = zero
742  DO 30 i = 1, base
743  d2 = d2 + b2
744  30 CONTINUE
745  GO TO 10
746  END IF
747 *+ END WHILE
748 *
749  RETURN
750 *
751 * End of SLAMC4
752 *
slamc3
real function slamc3(A, B)
SLAMC3
Definition: slamch.f:172

Here is the caller graph for this function: