Example 1: In the following example, the main program calls procedure P which uses the IEEE_ARITHMETIC module. The procedure changes the floating-point status before returning. The example displays the changes to the floating-point status before calling procedure P, on entry into the procedure, on exit from P, and after returning from the procedure.
PROGRAM MAIN
USE IEEE_ARITHMETIC
INTERFACE
SUBROUTINE P()
USE IEEE_ARITHMETIC
END SUBROUTINE P
END INTERFACE
LOGICAL, DIMENSION(5) :: FLAG_VALUES
TYPE(IEEE_ROUND_TYPE) :: ROUND_VALUE
CALL IEEE_SET_FLAG(IEEE_OVERFLOW, .TRUE.)
CALL IEEE_GET_FLAG(IEEE_ALL, FLAG_VALUES)
PRINT *, "MAIN: FLAGS ",FLAG_VALUES
CALL P()
CALL IEEE_GET_FLAG(IEEE_ALL, FLAG_VALUES)
PRINT *, "MAIN: FLAGS ",FLAG_VALUES
CALL IEEE_GET_ROUNDING_MODE(ROUND_VALUE)
IF (ROUND_VALUE == IEEE_NEAREST) THEN
PRINT *, "MAIN: ROUNDING MODE: IEEE_NEAREST"
ENDIF
END PROGRAM MAIN
SUBROUTINE P()
USE IEEE_ARITHMETIC
LOGICAL, DIMENSION(5) :: FLAG_VALUES
TYPE(IEEE_ROUND_TYPE) :: ROUND_VALUE
CALL IEEE_GET_FLAG(IEEE_ALL, FLAG_VALUES)
PRINT *, " P: FLAGS ON ENTRY: ",FLAG_VALUES
CALL IEEE_SET_ROUNDING_MODE(IEEE_TO_ZERO)
CALL IEEE_SET_HALTING_MODE(IEEE_OVERFLOW, .TRUE.)
CALL IEEE_SET_FLAG(IEEE_UNDERFLOW, .TRUE.)
CALL IEEE_GET_ROUNDING_MODE(ROUND_VALUE)
IF (ROUND_VALUE == IEEE_TO_ZERO) THEN
PRINT *, " P: ROUNDING MODE ON EXIT: IEEE_TO_ZERO"
ENDIF
CALL IEEE_GET_FLAG(IEEE_ALL, FLAG_VALUES)
PRINT *, " P: FLAGS ON EXIT: ",FLAG_VALUES
END SUBROUTINE P
When using the -qstrictieeemod compiler option to ensure compliance with rules for IEEE arithmetic, exception flags set before calling P are cleared on entry to P. Changes to the floating-point status occurring in P are undone when P returns, with the exception that flags set in P remain set after P returns:
main: flags T F F F F
P: flags on entry: F F F F F
P: rounding mode on exit: ieee_to_zero
P: flags on exit: F F F T F
main: flags T F F T F
main: rounding mode: ieee_nearest
When the -qnostrictieeemod compiler option is in effect, exception flags which were set before calling P remain set on entry to P. Changes to the floating point status occurring in P are propagated to the caller.
main: flags T F F F F
P: flags on entry: T F F F F
P: rounding mode on exit: ieee_to_zero
P: flags on exit: T F F T F
main: flags T F F T F
Example 2: In the following example, the main program calls procedure Q which uses neither IEEE_ARITHMETIC nor IEEE_EXCEPTIONS. Procedure Q changes the floating-point status before returning. The example displays the changes to the floating-point status before calling Q, on entry into the procedure, on exit from Q, and after returning from the procedure.
PROGRAM MAIN
USE IEEE_ARITHMETIC
LOGICAL, DIMENSION(5) :: FLAG_VALUES
TYPE(IEEE_ROUND_TYPE) :: ROUND_VALUE
CALL IEEE_SET_FLAG(IEEE_OVERFLOW, .TRUE.)
CALL IEEE_GET_FLAG(IEEE_ALL, FLAG_VALUES)
PRINT *, "MAIN: FLAGS ",FLAG_VALUES
CALL Q()
CALL IEEE_GET_FLAG(IEEE_ALL, FLAG_VALUES)
PRINT *, "MAIN: FLAGS ",FLAG_VALUES
CALL IEEE_GET_ROUNDING_MODE(ROUND_VALUE)
IF (ROUND_VALUE == IEEE_NEAREST) THEN
PRINT *, "MAIN: ROUNDING MODE: IEEE_NEAREST"
ENDIF
END PROGRAM MAIN
SUBROUTINE Q()
USE XLF_FP_UTIL
INTERFACE
FUNCTION GET_FLAGS()
LOGICAL, DIMENSION(5) :: GET_FLAGS
END FUNCTION
END INTERFACE
LOGICAL, DIMENSION(5) :: FLAG_VALUES
INTEGER(FP_MODE_KIND) :: OLDMODE
FLAG_VALUES = GET_FLAGS()
PRINT *, " Q: FLAGS ON ENTRY: ", FLAG_VALUES
CALL CLR_FPSCR_FLAGS(FP_OVERFLOW)
OLDMODE = SET_ROUND_MODE(FP_RND_RZ)
CALL SET_FPSCR_FLAGS(TRP_OVERFLOW)
CALL SET_FPSCR_FLAGS(FP_UNDERFLOW)
IF (GET_ROUND_MODE() == FP_RND_RZ) THEN
PRINT *, " Q: ROUNDING MODE ON EXIT: TO_ZERO"
ENDIF
FLAG_VALUES = GET_FLAGS()
PRINT *, " Q: FLAGS ON EXIT: ", FLAG_VALUES
END SUBROUTINE Q
! PRINT THE STATUS OF ALL EXCEPTION FLAGS
FUNCTION GET_FLAGS()
USE XLF_FP_UTIL
LOGICAL, DIMENSION(5) :: GET_FLAGS
INTEGER(FPSCR_KIND), DIMENSION(5) :: FLAGS
INTEGER I
FLAGS = (/ FP_OVERFLOW, FP_DIV_BY_ZERO, FP_INVALID, &
& FP_UNDERFLOW, FP_INEXACT /)
DO I=1,5
GET_FLAGS(I) = (GET_FPSCR_FLAGS(FLAGS(I)) /= 0)
END DO
END FUNCTION
When using the -qstrictieeemod compiler option to ensure compliance with rules for IEEE arithmetic, exception flags set before Q remain set on entry into Q. Changes to the floating-point status occurring in Q are undone when Q returns, with the exception that flags set in Q remain set after Q returns:
main: flags T F F F F
Q: flags on entry: T F F F F
Q: rounding mode on exit: to_zero
Q: flags on exit: F F F T F
main: flags T F F T F
main: rounding mode: ieee_nearest
When the -qnostrictieeemod option is in effect, exception flags set before calling Q remain set on entry into Q. Changes to the floating point status occurring in Q are propagated to the caller.
main: flags T F F F F
Q: flags on entry: T F F F F
Q: rounding mode on exit: to_zero
Q: flags on exit: F F F T F
main: flags F F F T F
+----------------------------End of IBM Extension----------------------------+