!=======================================================================
!   FILE: TEST18.F90
!   DATE: 8 July 2005
!
!   TEST: Floating-Point Underflow if not detected can cause wrong
!         answers.
!
!   Contact: H. D. Knoble
!=======================================================================
           subroutine sethem(v,x,y)
           double precision v,x,y
            v=1.D-307
            x=1.D+307
            y=1.D+306
           return
         end
        program test
           double precision u,v,x,y,z
           CHARACTER*100 VALUE
!          Call PERMIT_UNDERFLOW@(.TRUE.)
!          CALL DOSPARAM@('OS',VALUE)
           call sethem(v,x,y)
           z=(v*v*v)
           u=z*(x*x*y)*30.0D0
           write(*,*) 'Algebraically U is 3.0'
           write(*,*) 'U=',u
           stop
        end