Subroutine */
| 1798 | /* *********************************************************************** */ |
| 1799 | |
| 1800 | /* Subroutine */ int slamc4_(integer *emin, real *start, integer *base) |
| 1801 | { |
| 1802 | /* System generated locals */ |
| 1803 | integer i__1; |
| 1804 | real r__1; |
| 1805 | |
| 1806 | /* Local variables */ |
| 1807 | static real a; |
| 1808 | static integer i__; |
| 1809 | static real b1, b2, c1, c2, d1, d2, one, zero, rbase; |
| 1810 | extern doublereal slamc3_(real *, real *); |
| 1811 | |
| 1812 | |
| 1813 | /* |
| 1814 | -- LAPACK auxiliary routine (version 3.2) -- |
| 1815 | Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. |
| 1816 | November 2006 |
| 1817 | |
| 1818 | |
| 1819 | Purpose |
| 1820 | ======= |
| 1821 | |
| 1822 | SLAMC4 is a service routine for SLAMC2. |
| 1823 | |
| 1824 | Arguments |
| 1825 | ========= |
| 1826 | |
| 1827 | EMIN (output) INTEGER |
| 1828 | The minimum exponent before (gradual) underflow, computed by |
| 1829 | setting A = START and dividing by BASE until the previous A |
| 1830 | can not be recovered. |
| 1831 | |
| 1832 | START (input) REAL |
| 1833 | The starting point for determining EMIN. |
| 1834 | |
| 1835 | BASE (input) INTEGER |
| 1836 | The base of the machine. |
| 1837 | |
| 1838 | ===================================================================== |
| 1839 | */ |
| 1840 | |
| 1841 | |
| 1842 | a = *start; |
| 1843 | one = 1.f; |
| 1844 | rbase = one / *base; |
| 1845 | zero = 0.f; |
| 1846 | *emin = 1; |
| 1847 | r__1 = a * rbase; |
| 1848 | b1 = slamc3_(&r__1, &zero); |
| 1849 | c1 = a; |
| 1850 | c2 = a; |
| 1851 | d1 = a; |
| 1852 | d2 = a; |
| 1853 | /* |
| 1854 | + WHILE( ( C1.EQ.A ).AND.( C2.EQ.A ).AND. |
| 1855 | $ ( D1.EQ.A ).AND.( D2.EQ.A ) )LOOP |
| 1856 | */ |
| 1857 | L10: |