program subnrm ************************************************************************ * (Subnorms -- single/double) * Report the smallest representable numbers in each of IEEE 754 * single- and double--precision arithmetic. On some systems, these * may be subnormal, and on others, not. * (20-Jul-2000) ************************************************************************ REAL*4 smin, sstorf REAL*8 dmin, dstorf * REAL*16 qmin, qstorf INTEGER n, ismin(1), idmin(2) * INTEGER iqmin(4) EQUIVALENCE (smin, ismin(1)) EQUIVALENCE (dmin, idmin(1)) * EQUIVALENCE (qmin, iqmin(1)) * smin = 1 n = 0 10 IF (sstorf(smin / 2.0e+00) .GT. 0) THEN smin = sstorf(smin / 2.0e+00) n = n - 1 GO TO 10 END IF WRITE (6,10000) n, smin, ismin * dmin = 1 n = 0 20 IF (dstorf(dmin / 2.0d+00) .GT. 0) THEN dmin = dstorf(dmin / 2.0d+00) n = n - 1 GO TO 20 END IF WRITE (6,10000) n, dmin, idmin * * qmin = 1 * n = 0 * 30 IF (qstorf(qmin / 2.0q+00) .GT. 0) THEN * qmin = qstorf(qmin / 2.0q+00) * n = n - 1 * * DEBUG printing because Lahey/Fujitsu lf95 quits on * quadruple-precision underflow, sigh... * * IF (n .LE. -16380) WRITE (6,10000) n, qmin, iqmin * GO TO 30 * END IF * WRITE (6,10000) n, qmin, iqmin * 10000 FORMAT (i6, 2x, 1p, e15.4e4, 2x, 4z9.8) END REAL*4 FUNCTION sstorf(x) REAL*4 x sstorf = x END REAL*8 FUNCTION dstorf(x) REAL*8 x dstorf = x END * REAL*16 FUNCTION qstorf(x) * REAL*16 x * qstorf = x * END