Intel® Fortran Compiler Classic and Intel® Fortran Compiler Developer Guide and Reference

ID 767251
Date 6/24/2024
Public

A newer version of this document is available. Customers should click here to go to the newest version.

Document Table of Contents

FOR_SET_FPE

Runtime Function: Sets the floating-point exception flags. This routine can be called from a C or Fortran program.

Module

USE IFCORE

result = FOR_SET_FPE (a)

a

Must be of type INTEGER(4). It contains bit flags controlling floating-point exception trapping, reporting, and result handling.

Results

The result type is INTEGER(4). The return value represents the previous settings of the floating-point exception flags. The meanings of the bits are defined in the IFCORE module file.

To get the current settings of the floating-point exception flags, use FOR_GET_FPE.

Example

USE IFCORE
INTEGER*4 OLD_FPE_FLAGS, NEW_FPE_FLAGS
OLD_FPE_FLAGS = FOR_SET_FPE (NEW_FPE_FLAGS)

The following example program is compiled without any fpe options. However, it uses calls to for_set_fpe to enable the same flags as when compiling with option fpe:0. The new flags can be verified by compiling the program with option -fpe:0.

   program samplefpe
   use ifcore
   implicit none

   INTEGER(4) :: ORIGINAL_FPE_FLAGS, NEW_FPE_FLAGS
   INTEGER(4) :: CURRENT_FPE_FLAGS, PREVIOUS_FPE_FLAGS

   NEW_FPE_FLAGS = FPE_M_TRAP_UND + FPE_M_TRAP_OVF + FPE_M_TRAP_DIV0  &
     + FPE_M_TRAP_INV + FPE_M_ABRUPT_UND + FPE_M_ABRUPT_DMZ
   ORIGINAL_FPE_FLAGS = FOR_SET_FPE (NEW_FPE_FLAGS)
   CURRENT_FPE_FLAGS = FOR_GET_FPE ()

   print *,"The original FPE FLAGS were:"
   CALL PRINT_FPE_FLAGS(ORIGINAL_FPE_FLAGS)

   print *," "   print *,"The new FPE FLAGS are:"
   CALL PRINT_FPE_FLAGS(CURRENT_FPE_FLAGS)

!! restore the fpe flag to their original values
   PREVIOUS_FPE_FLAGS = FOR_SET_FPE (ORIGINAL_FPE_FLAGS)

   end

   subroutine PRINT_FPE_FLAGS(fpe_flags)
   use ifcore
   implicit none
   integer(4)   :: fpe_flags
   character(3) :: toggle

   print 10, fpe_flags, fpe_flags
10 format(X,'FPE FLAGS = 0X',Z8.8," B'",B32.32)

   if ( IAND(fpe_flags, FPE_M_TRAP_UND) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_TRAP_UND    :", toggle

   if ( IAND(fpe_flags, FPE_M_TRAP_OVF) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_TRAP_OVF    :", toggle

   if ( IAND(fpe_flags, FPE_M_TRAP_DIV0) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_TRAP_DIV0   :", toggle

   if ( IAND(fpe_flags, FPE_M_TRAP_INV) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_TRAP_INV    :", toggle

   if ( IAND(fpe_flags, FPE_M_ABRUPT_UND) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_ABRUPT_UND  :", toggle

   if ( IAND(fpe_flags, FPE_M_ABRUPT_OVF) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_ABRUPT_OVF  :", toggle

   if ( IAND(fpe_flags, FPE_M_ABRUPT_DMZ) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_ABRUPT_DIV0 :", toggle

   if ( IAND(fpe_flags, FPE_M_ABRUPT_DIV0) .ne. 0 ) then
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_ABRUPT_INV  :", toggle

   if ( IAND(fpe_flags, FPE_M_ABRUPT_DMZ) .ne. 0 ) then ! ABRUPT_DMZ
     toggle = "ON"
   else
     toggle = "OFF"
   endif
   write(*,*) "  FPE_ABRUPT_DMZ  :", toggle, "  (ftz related)"

   end subroutine PRINT_FPE_FLAGS

The following shows the output from the above program:

>ifx set_fpe_sample01.f90
>set_fpe_sample01.exe
 The original FPE FLAGS were:
 FPE FLAGS = 0X00000000 B'00000000000000000000000000000000
   FPE_TRAP_UND    :OFF
   FPE_TRAP_OVF    :OFF
   FPE_TRAP_DIV0   :OFF
   FPE_TRAP_INV    :OFF
   FPE_ABRUPT_UND  :OFF
   FPE_ABRUPT_OVF  :OFF
   FPE_ABRUPT_DIV0 :OFF
   FPE_ABRUPT_INV  :OFF
   FPE_ABRUPT_DMZ  :OFF (ftz related)

 The new FPE FLAGS are:
 FPE FLAGS = 0X0011000F B'00000000000100010000000000001111
   FPE_TRAP_UND    :ON
   FPE_TRAP_OVF    :ON
   FPE_TRAP_DIV0   :ON
   FPE_TRAP_INV    :ON
   FPE_ABRUPT_UND  :ON
   FPE_ABRUPT_OVF  :OFF
   FPE_ABRUPT_DIV0 :ON
   FPE_ABRUPT_INV  :OFF
   FPE_ABRUPT_DMZ  :ON (ftz related)

The following example builds a library that has to have a particular setting of the fpe flags internally, and has to work with user programs built with any combination of the fpe flags.

    !-- file USE.F90 starts here
subroutine use_subnorms
    use, intrinsic :: ieee_arithmetic
    use ifcore

    use, intrinsic :: ieee_features, only: ieee_subnormal
    implicit none

    !--- Declaration for use in example code
        real, volatile ::     x, y
        integer  i
    !--- End declarations for example code

    integer(4) :: orig_flags, off_flags, not_flags, new_flags

    if (ieee_support_subnormal()) then
        print *, "Subnormals already supported"
    else
        orig_flags = for_get_fpe()

        off_flags = IOR(FPE_M_ABRUPT_UND, FPE_M_ABRUPT_DMZ)
        off_flags = IOR(off_flags,        FPE_M_TRAP_UND)
        off_flags = IOR(off_flags,        FPE_M_MSG_UND)
        not_flags = NOT(off_flags)        ! "INOT" is the 16-bit version!

        new_flags  = IAND(orig_flags, not_flags)
        orig_flags = for_set_fpe(new_flags)

        if (ieee_support_subnormal()) then
            print *, "Subnormals are now supported"
        else
            print *, "Error: Subnormals still not supported after FOR_SET_FPE call"
        end if
    end if

    !-- Begin example of user code using subnorms
1      FORMAT(1X,Z)
2      FORMAT("Use subnormals",1X,E40.25)

        x = 0.0
        y = tiny(x)

        ! Print as real values
        !        print 2, x, y

        ! Expect non-zero numbers
        !
        do i = 1, 20
            y = y / 2.0
            print 1,y
        enddo
    !-- End example of user code using subnorms

 end subroutine use_subnorms
    !-- end of file USE.F90

    !-- File FLUSH.F90 starts here
subroutine flush_subnorms
    use, intrinsic :: ieee_arithmetic
    use ifcore
    use, intrinsic :: ieee_features
    implicit none

    !--- Declaration for use in example code
        real, volatile ::     x, y
        integer  i
    !--- End declarations for example code

    integer(4) :: orig_flags, off_flags, new_flags

    if (ieee_support_subnormal()) then
        print *, "Subnormals already supported; turn off"
        orig_flags = for_get_fpe()

        off_flags = IOR(FPE_M_ABRUPT_UND, FPE_M_ABRUPT_DMZ)
        off_flags = IOR(off_flags,        FPE_M_TRAP_UND)
        off_flags = IOR(off_flags,        FPE_M_MSG_UND)

        new_flags  = IOR(orig_flags, off_flags)
        orig_flags = for_set_fpe(new_flags)

        if (ieee_support_subnormal()) then
            print *, "Error: Subnormals still supported after FOR_SET_FPE call"
        else
            print *, "Subnormals are now NOT supported, should flush to zero"
        end if

    else
        print *, "Subnormals already not supported"
    end if

    !-- Begin example of user code doing flush-to-zero

1      FORMAT(1X,Z)
2      FORMAT("Flush to zero",1X,E40.25)

        x = 0.0
        y = tiny(x)

        ! Print as real values
        !
        print 2, x, y

        ! Expect zeros
        !
        do i = 1, 20
            y = y / 2.0
            print 1,y
        enddo

    !-- End example of user code doing flush-to-zero

end subroutine flush_subnorms
    !-- end of file FLUSH.F90

    !-- File MAIN.F90 starts here
program example
    implicit none

    call use_subnorms      ! Will use subnorms
    call flush_subnorms    ! Will flush
    call use_subnorms      ! Will also flush, but WON'T use subnorms!
 
end program example
    !-- end of file MAIN.F90

You can specify the following lines to compile and link the above program:

ifx -c -fpic -no-ftz -fpe3   use.f90
ifx -c -fpic -ftz            flush.f90 
ifx -c -fpic                 main.f90
ifx -o main.exe main.o use.o flush.o