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