Visible to Intel only — GUID: GUID-494F8AEB-6843-448F-B49C-BE85976BC0A3
Visible to Intel only — GUID: GUID-494F8AEB-6843-448F-B49C-BE85976BC0A3
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