real(kind=4), intent(in) :: X
type(IEEE_CLASS_TYPE), intent(in) :: CLASS
+ logical flag
select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
case (2) ! IEEE_QUIET_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
case (3) ! IEEE_NEGATIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = (-res) * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case (4) ! IEEE_NEGATIVE_NORMAL
res = -42
case (5) ! IEEE_NEGATIVE_DENORMAL
case (9) ! IEEE_POSITIVE_NORMAL
res = 42
case (10) ! IEEE_POSITIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = res * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case default ! IEEE_OTHER_VALUE, should not happen
res = 0
end select
real(kind=8), intent(in) :: X
type(IEEE_CLASS_TYPE), intent(in) :: CLASS
+ logical flag
select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
case (2) ! IEEE_QUIET_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
case (3) ! IEEE_NEGATIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = (-res) * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case (4) ! IEEE_NEGATIVE_NORMAL
res = -42
case (5) ! IEEE_NEGATIVE_DENORMAL
case (9) ! IEEE_POSITIVE_NORMAL
res = 42
case (10) ! IEEE_POSITIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = res * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case default ! IEEE_OTHER_VALUE, should not happen
res = 0
end select
real(kind=10), intent(in) :: X
type(IEEE_CLASS_TYPE), intent(in) :: CLASS
+ logical flag
select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
case (2) ! IEEE_QUIET_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
- case (3) ! IEEE_NEGATIVE_INF
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
+ case (3) ! IEEE_NEGATIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = (-res) * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case (4) ! IEEE_NEGATIVE_NORMAL
res = -42
case (5) ! IEEE_NEGATIVE_DENORMAL
case (9) ! IEEE_POSITIVE_NORMAL
res = 42
case (10) ! IEEE_POSITIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = res * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case default ! IEEE_OTHER_VALUE, should not happen
res = 0
end select
real(kind=16), intent(in) :: X
type(IEEE_CLASS_TYPE), intent(in) :: CLASS
+ logical flag
select case (CLASS%hidden)
case (1) ! IEEE_SIGNALING_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
case (2) ! IEEE_QUIET_NAN
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_get_halting_mode(ieee_invalid, flag)
+ call ieee_set_halting_mode(ieee_invalid, .false.)
+ end if
res = -1
res = sqrt(res)
+ if (ieee_support_halting(ieee_invalid)) then
+ call ieee_set_halting_mode(ieee_invalid, flag)
+ end if
case (3) ! IEEE_NEGATIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = (-res) * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case (4) ! IEEE_NEGATIVE_NORMAL
res = -42
case (5) ! IEEE_NEGATIVE_DENORMAL
case (9) ! IEEE_POSITIVE_NORMAL
res = 42
case (10) ! IEEE_POSITIVE_INF
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_get_halting_mode(ieee_overflow, flag)
+ call ieee_set_halting_mode(ieee_overflow, .false.)
+ end if
res = huge(res)
res = res * res
+ if (ieee_support_halting(ieee_overflow)) then
+ call ieee_set_halting_mode(ieee_overflow, flag)
+ end if
case default ! IEEE_OTHER_VALUE, should not happen
res = 0
end select