program subnrm ************************************************************************ * (Subnorms -- single/double/quadruple) * Report the smallest representable numbers in each of IEEE 754 * single-, double-, and quadruple-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), 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