PROGRAM fpe_handler2 c This example shows how to use libfpe.a from c within a FORTRAN program. See the c handle_sigfpes(3F) man page for additional c information. c c f77 fpe_handler2.f -o fpe_handler2 -lfpe c ./fpe_handler2 c c expecting overflow c error is floating point overflow c return value set to = 100.0000000000000 c c expecting underflow c error is floating point underflow c return value set to = 200.0000000000000 c c expecting divide by zero c error is divide by zero c return value set to = 300.0000000000000 call init() call doit() stop END SUBROUTINE doit() c ************************************************ c * Cause the floating point exceptions to occur. c ************************************************ real * 8 qr1,zero,ten,max,min zero = 0.d0 ten = 10.0 max = 1.797693134862314e+308 min = 2.2250738585072014e-308 write(6,*) 'expecting overflow' qr1 = max * ten write(6,*) 'return value set to = ',qr1 write(6,*) ' ' write(6,*) 'expecting underflow' qr1 = min/ten write(6,*) 'return value set to = ',qr1 write(6,*) ' ' write(6,*) 'expecting divide by zero' qr1 = min/zero write(6,*) 'return value set to = ',qr1 write(6,*) ' ' return End SUBROUTINE init() c ************************************************ c * Initialize floating point exceptions. c * This code below initializes the floating c * point exception common block that is used to c * indicate what floating point exceptions will c * be caught. c ************************************************ # include Integer * 4 en_mask External my_fpe_bomb fsigfpe(FPE_OVERFL).repls = FPE_USER_DETERMINED fsigfpe(FPE_OVERFL).count = 0 fsigfpe(FPE_OVERFL).trace = 0 fsigfpe(FPE_OVERFL).abort = 0 fsigfpe(FPE_OVERFL).exit = 0 fsigfpe(FPE_UNDERFL).repls = FPE_USER_DETERMINED fsigfpe(FPE_UNDERFL).count = 0 fsigfpe(FPE_UNDERFL).trace = 0 fsigfpe(FPE_UNDERFL).abort = 0 fsigfpe(FPE_UNDERFL).exit = 0 fsigfpe(FPE_DIVZERO).repls = FPE_USER_DETERMINED fsigfpe(FPE_DIVZERO).count = 0 fsigfpe(FPE_DIVZERO).trace = 0 fsigfpe(FPE_DIVZERO).abort = 0 fsigfpe(FPE_DIVZERO).exit = 0 fsigfpe(FPE_INVALID).repls = FPE_USER_DETERMINED fsigfpe(FPE_INVALID).count = 0 fsigfpe(FPE_INVALID).trace = 0 fsigfpe(FPE_INVALID).abort = 0 fsigfpe(FPE_INVALID).exit = 0 en_mask = FPE_EN_UNDERFL + FPE_EN_OVERFL + . FPE_EN_DIVZERO + FPE_EN_INVALID c * Tell the libfpe.a library to invoke c * SUBROUTINE my_fpe_bomb when any 'en_mask' c * floating point exceptions occur. my_fpe_bomb c * handles the floating point exception. call handle_sigfpes( FPE_ON, en_mask, . my_fpe_bomb, 0, 0 ) return End SUBROUTINE my_fpe_bomb(fpe_parms, value) c *********************************************** c * Assigns value in event of Floating Point c * Error. c *********************************************** # include integer * 4 fpe_parms(0:4) real * 8 value integer * 4 etype etype = fpe_parms(0) if (etype .eq. FPE_OVERFL ) then write(6,*) 'error is floating point overflow' value = 100.0 elseif (etype .eq. FPE_UNDERFL) then write(6,*) 'error is floating point underflow' value = 200.0 elseif (etype .eq. FPE_DIVZERO) then write(6,*) 'error is divide by zero' value = 300.0 elseif (etype .eq. FPE_INVALID) then write(6,*) 'error is invalid' value = 400.0 end if return End