TABLE OF CONTENTS
ABINIT/m_xieee [ Modules ]
NAME
m_xieee
FUNCTION
Debugging tools and helper functions providing access to IEEE exceptions
COPYRIGHT
Copyright (C) 2014-2024 ABINIT group (MG) This file is distributed under the terms of the GNU General Public License, see ~abinit/COPYING or http://www.gnu.org/copyleft/gpl.txt .
NOTES
See F2003 standard and http://www.nag.com/nagware/np/r51_doc/ieee_exceptions.html
SOURCE
19 #if defined HAVE_CONFIG_H 20 #include "config.h" 21 #endif 22 23 #include "abi_common.h" 24 25 module m_xieee 26 27 #ifdef HAVE_FC_IEEE_EXCEPTIONS 28 !use, intrinsic :: ieee_exceptions 29 use ieee_exceptions 30 #endif 31 32 implicit none 33 34 private 35 36 public :: xieee_halt_ifexc ! Halt the code if one of the *usual* IEEE exceptions is raised. 37 public :: xieee_signal_ifexc ! Signal if any IEEE exception is raised. 38 39 integer,private,parameter :: std_out = 6 40 41 contains
m_xieee/xieee_halt_ifexc [ Functions ]
[ Top ] [ m_xieee ] [ Functions ]
NAME
xieee_halt_ifexc
FUNCTION
Halt the code if one of the *usual* IEEE exceptions is raised.
INPUTS
halt= If the value is true, the exceptions will cause halting; otherwise, execution will continue after this exception.
SOURCE
56 subroutine xieee_halt_ifexc(halt) 57 58 !Arguments ------------------------------------ 59 !scalars 60 logical,intent(in) :: halt 61 ! ************************************************************************* 62 63 #ifdef HAVE_FC_IEEE_EXCEPTIONS 64 ! Possible Flags: ieee_invalid, ieee_overflow, ieee_divide_by_zero, ieee_inexact, and ieee_underflow 65 if (ieee_support_halting(ieee_invalid)) then 66 call ieee_set_halting_mode(ieee_invalid, halt) 67 end if 68 if (ieee_support_halting(ieee_overflow)) then 69 call ieee_set_halting_mode(ieee_overflow, halt) 70 end if 71 if (ieee_support_halting(ieee_divide_by_zero)) then 72 call ieee_set_halting_mode(ieee_divide_by_zero, halt) 73 end if 74 !if (ieee_support_halting(ieee_inexact)) then 75 ! call ieee_set_halting_mode(ieee_inexact, halt) 76 !end if 77 !if (ieee_support_halting(ieee_underflow)) then 78 ! call ieee_set_halting_mode(ieee_underflow, halt) 79 !end if 80 #else 81 write(std_out,*)"Cannot set halting mode to: ",halt 82 #endif 83 84 end subroutine xieee_halt_ifexc
m_xieee/xieee_signal_ifexc [ Functions ]
[ Top ] [ m_xieee ] [ Functions ]
NAME
xieee_signal_ifexc
FUNCTION
Signal if one of the *usual* IEEE exceptions is raised.
INPUTS
flag= If the value is true, the exceptions will be signalled
SOURCE
101 subroutine xieee_signal_ifexc(flag) 102 103 !Arguments ------------------------------------ 104 !scalars 105 logical,intent(in) :: flag 106 ! ************************************************************************* 107 108 #ifdef HAVE_FC_IEEE_EXCEPTIONS 109 ! Possible Flags: ieee_invalid, ieee_overflow, ieee_divide_by_zero, ieee_inexact, and ieee_underflow 110 call ieee_set_flag(ieee_invalid, flag) 111 call ieee_set_flag(ieee_overflow, flag) 112 call ieee_set_flag(ieee_divide_by_zero, flag) 113 call ieee_set_flag(ieee_inexact, flag) 114 call ieee_set_flag(ieee_underflow, flag) 115 #else 116 write(std_out,*)"Cannot set signal flag to: ",flag 117 #endif 118 119 end subroutine xieee_signal_ifexc