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-2022 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