インテル® Fortran コンパイラー 14.0 ユーザー・リファレンス・ガイド

FOR_SET_FPE

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.

This function is not available on Intel® 64 architecture, targeting Intel® MIC Architecture.

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

このヘルプトピックについてのフィードバックを送信