      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
