home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 30 fixes_v / 30-fixes_v.zip / f16_b.zip / GD35.B < prev    next >
Text File  |  1994-01-11  |  2KB  |  87 lines
  1.       program mathdemo
  2.  
  3. * MATHDEMO.FOR - This program forms part of a collection of FORTRAN
  4. *         code that demonstrates how to take over control of
  5. *         math error handling from the run-time system.
  6.  
  7. * Compile: &cmpcmd mathdemo
  8. * Link:    &lnkcmd file mathdemo, cw87, _matherr
  9.  
  10. * Notes:
  11. * (1) We call "cw87" to enable underflow exceptions which are
  12. *     masked (ignored) by default.
  13. * (2) The signal handler must be re-installed after each signal
  14. *     (it can also be re-installed even when there is no signal).
  15. * (3) To prevent compile-time constant folding in expressions,
  16. *     we add log(1.0) which is 0.  We do this for the sake of
  17. *     demonstrating exception handling.
  18.  
  19.       implicit none
  20.  
  21.       double precision x, y, z
  22.  
  23.       call cw87     ! init 80x87 control word
  24.  
  25.       call resetFPE    ! install signal handler
  26.       print *, ' '
  27.       print *, 'Divide by zero will be attempted'
  28.       x = 1.0d0 + DLOG( 1.0d0 )
  29.       y = 0.0d0
  30.       z = x / y
  31.       call chkFPE    ! check for exception
  32.       print *, z
  33.  
  34.       call resetFPE    ! install signal handler
  35.       print *, ' '
  36.       print *, 'Overflow will be attempted'
  37.       x = 1.2d300 + DLOG( 1.0d0 )
  38.       y = 1.2d300
  39.       z = x * y
  40.       call chkFPE    ! check for exception
  41.       print *, z
  42.  
  43.       call resetFPE    ! install signal handler
  44.       print *, ' '
  45.       print *, 'Underflow will be attempted'
  46.       x = 1.14d-300 + DLOG( 1.0d0 )
  47.       y = 2.24d-308
  48.       z = x * y
  49.       call chkFPE    ! check for exception
  50.       print *, z
  51.  
  52.       call resetFPE    ! install signal handler
  53.       print *, ' '
  54.       print *, 'Math error will be attempted'
  55.       x = -12.0
  56.       y = SQRT( x )
  57.       call chkFPE    ! check for exception
  58.       print *, x, y
  59.       end
  60.  
  61.       subroutine resetFPE
  62.       include 'fsignal.fi'
  63.       external fpe_handler
  64.       logical fpe_flag
  65.       common fpe_flag
  66.       fpe_flag = .false.
  67.       call fsignal( SIGFPE, fpe_handler )
  68.       end
  69.  
  70.       subroutine fpe_handler()
  71.       logical fpe_flag
  72.       common fpe_flag
  73.       fpe_flag = .true.
  74.       end
  75.  
  76.       subroutine chkFPE
  77.       logical fpe_flag
  78.       common fpe_flag
  79. *     "volatile" is not needed here but would be
  80. *     needed in main program if it references "fpe_flag"
  81.       if( volatile( fpe_flag ) ) then
  82.     print *, '*ERROR* exception occurred'
  83.       else
  84.     print *, '*OK* no exception occurred'
  85.       endif
  86.       end
  87.