LAPACK  3.10.1
LAPACK: Linear Algebra PACKage

◆ slamc4()

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

686 *
687 * -- LAPACK auxiliary routine --
688 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
689 *
690 * .. Scalar Arguments ..
691  INTEGER BASE
692  INTEGER EMIN
693  REAL START
694 * ..
695 * =====================================================================
696 *
697 * .. Local Scalars ..
698  INTEGER I
699  REAL A, B1, B2, C1, C2, D1, D2, ONE, RBASE, ZERO
700 * ..
701 * .. External Functions ..
702  REAL SLAMC3
703  EXTERNAL slamc3
704 * ..
705 * .. Executable Statements ..
706 *
707  a = start
708  one = 1
709  rbase = one / base
710  zero = 0
711  emin = 1
712  b1 = slamc3( a*rbase, zero )
713  c1 = a
714  c2 = a
715  d1 = a
716  d2 = a
717 *+ WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND.
718 * $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP
719  10 CONTINUE
720  IF( ( c1.EQ.a ) .AND. ( c2.EQ.a ) .AND. ( d1.EQ.a ) .AND.
721  $ ( d2.EQ.a ) ) THEN
722  emin = emin - 1
723  a = b1
724  b1 = slamc3( a / base, zero )
725  c1 = slamc3( b1*base, zero )
726  d1 = zero
727  DO 20 i = 1, base
728  d1 = d1 + b1
729  20 CONTINUE
730  b2 = slamc3( a*rbase, zero )
731  c2 = slamc3( b2 / rbase, zero )
732  d2 = zero
733  DO 30 i = 1, base
734  d2 = d2 + b2
735  30 CONTINUE
736  GO TO 10
737  END IF
738 *+ END WHILE
739 *
740  RETURN
741 *
742 * End of SLAMC4
743 *
real function slamc3(A, B)
SLAMC3
Definition: slamch.f:169
Here is the caller graph for this function: