インテル® Fortran コンパイラー 19.0 デベロッパー・ガイドおよびリファレンス
Run-Time Function: Sets the floating-point exception flags. This routine can be called from a C or Fortran program.
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. |
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.
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_denorms
use, intrinsic :: ieee_arithmetic
use ifcore
use, intrinsic :: ieee_features, only: ieee_denormal
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_denormal()) then
print *, "Denormals 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_denormal()) then
print *, "Denormals are now supported"
else
print *, "Error: Denormals still not supported after FOR_SET_FPE call"
end if
end if
!-- Begin example of user code using denorms
1 FORMAT(1X,Z)
2 FORMAT("Use denormals",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 denorms
end subroutine use_denorms
!-- end of file USE.F90
!-- File FLUSH.F90 starts here
subroutine flush_denorms
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_denormal()) then
print *, "Denormals 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_denormal()) then
print *, "Error: Denormals still supported after FOR_SET_FPE call"
else
print *, "Denormals are now NOT supported, should flush to zero"
end if
else
print *, "Denormals 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_denorms
!-- end of file FLUSH.F90
!-- File MAIN.F90 starts here
program example
implicit none
call use_denorms ! Will use denorms
call flush_denorms ! Will flush
call use_denorms ! Will also flush, but WON'T use denorms!
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