TABLE OF CONTENTS


ABINIT/m_xieee [ Modules ]

[ Top ] [ Modules ]

NAME

  m_xieee

FUNCTION

   Debugging tools and helper functions providing access to IEEE exceptions

COPYRIGHT

  Copyright (C) 2014-2018 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

PARENTS

CHILDREN

SOURCE

24 #if defined HAVE_CONFIG_H
25 #include "config.h"
26 #endif
27 
28 #include "abi_common.h"
29 
30 module m_xieee
31 
32 #ifdef HAVE_FC_IEEE_EXCEPTIONS
33  !use, intrinsic :: ieee_exceptions  ! abilint does not like intrinsic
34  use ieee_exceptions 
35 #endif
36     
37  implicit none
38 
39  private
40 
41  public :: xieee_halt_ifexc       ! Halt the code if one of the *usual* IEEE exceptions is raised.
42  public :: xieee_signal_ifexc     ! Signal if any IEEE exception is raised.
43 
44  integer,private,parameter :: std_out = 6
45 
46 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.

PARENTS

      m_argparse

CHILDREN

      ieee_set_flag

SOURCE

 67 subroutine xieee_halt_ifexc(halt)
 68 
 69 !Arguments ------------------------------------
 70 !scalars
 71 
 72 !This section has been created automatically by the script Abilint (TD).
 73 !Do not modify the following lines by hand.
 74 #undef ABI_FUNC
 75 #define ABI_FUNC 'xieee_halt_ifexc'
 76 !End of the abilint section
 77 
 78  logical,intent(in) :: halt
 79 ! *************************************************************************
 80     
 81 #ifdef HAVE_FC_IEEE_EXCEPTIONS
 82  ! Possible Flags: ieee_invalid, ieee_overflow, ieee_divide_by_zero, ieee_inexact, and ieee_underflow
 83  if (ieee_support_halting(ieee_invalid)) then
 84    call ieee_set_halting_mode(ieee_invalid, halt)
 85  end if
 86  if (ieee_support_halting(ieee_overflow)) then
 87    call ieee_set_halting_mode(ieee_overflow, halt)
 88  end if
 89  if (ieee_support_halting(ieee_divide_by_zero)) then
 90    call ieee_set_halting_mode(ieee_divide_by_zero, halt)
 91  end if
 92  !if (ieee_support_halting(ieee_inexact)) then
 93  !  call ieee_set_halting_mode(ieee_inexact, halt)
 94  !end if
 95  !if (ieee_support_halting(ieee_underflow)) then
 96  !  call ieee_set_halting_mode(ieee_underflow, halt)
 97  !end if
 98 #else
 99  write(std_out,*)"Cannot set halting mode to: ",halt
100 #endif
101 
102 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

PARENTS

      m_argparse

CHILDREN

      ieee_set_flag

SOURCE

125 subroutine xieee_signal_ifexc(flag)
126 
127 !Arguments ------------------------------------
128 !scalars
129 
130 !This section has been created automatically by the script Abilint (TD).
131 !Do not modify the following lines by hand.
132 #undef ABI_FUNC
133 #define ABI_FUNC 'xieee_signal_ifexc'
134 !End of the abilint section
135 
136  logical,intent(in) :: flag
137 ! *************************************************************************
138     
139 #ifdef HAVE_FC_IEEE_EXCEPTIONS
140  ! Possible Flags: ieee_invalid, ieee_overflow, ieee_divide_by_zero, ieee_inexact, and ieee_underflow
141  call ieee_set_flag(ieee_invalid, flag)
142  call ieee_set_flag(ieee_overflow, flag)
143  call ieee_set_flag(ieee_divide_by_zero, flag)
144  call ieee_set_flag(ieee_inexact, flag)
145  call ieee_set_flag(ieee_underflow, flag)
146 #else
147  write(std_out,*)"Cannot set signal flag to: ",flag
148 #endif
149 
150 end subroutine xieee_signal_ifexc