# FOR_SET_FPE

Run-Time 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:

    >ifort 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:

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

Parent topic: E to F