Skip to content

ieeeck: use ieee_arithmetic intrinsics #933

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Feb 10, 2025
Merged

ieeeck: use ieee_arithmetic intrinsics #933

Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
79 changes: 11 additions & 68 deletions src/lapack/stdlib_linalg_lapack_aux.fypp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
module stdlib_linalg_lapack_aux
use stdlib_linalg_constants
use stdlib_linalg_blas
use ieee_arithmetic, only: ieee_support_inf, ieee_support_nan
implicit none
private

Expand Down Expand Up @@ -111,83 +112,25 @@ module stdlib_linalg_lapack_aux
! Scalar Arguments
integer(${ik}$), intent(in) :: ispec
real(sp), intent(in) :: one, zero

! =====================================================================
! Local Scalars
real(sp) :: nan1, nan2, nan3, nan4, nan5, nan6, neginf, negzro, newzro, posinf
! Executable Statements
! Executable Statements
stdlib${ii}$_ieeeck = 1
posinf = one / zero
if( posinf<=one ) then
stdlib${ii}$_ieeeck = 0
return
end if
neginf = -one / zero
if( neginf>=zero ) then
stdlib${ii}$_ieeeck = 0
return
end if
negzro = one / ( neginf+one )
if( negzro/=zero ) then
stdlib${ii}$_ieeeck = 0
return
end if
neginf = one / negzro
if( neginf>=zero ) then
stdlib${ii}$_ieeeck = 0
return
end if
newzro = negzro + zero
if( newzro/=zero ) then
stdlib${ii}$_ieeeck = 0
return
end if
posinf = one / newzro
if( posinf<=one ) then
stdlib${ii}$_ieeeck = 0
return
end if
neginf = neginf*posinf
if( neginf>=zero ) then
stdlib${ii}$_ieeeck = 0
return
end if
posinf = posinf*posinf
if( posinf<=one ) then

! Test support for infinity values
if (.not.ieee_support_inf(one)) then
stdlib${ii}$_ieeeck = 0
return
end if

! return if we were only asked to check infinity arithmetic
if( ispec==0 )return
nan1 = posinf + neginf
nan2 = posinf / neginf
nan3 = posinf / posinf
nan4 = posinf*zero
nan5 = neginf*negzro
nan6 = nan5*zero
if( nan1==nan1 ) then
stdlib${ii}$_ieeeck = 0
return
end if
if( nan2==nan2 ) then
stdlib${ii}$_ieeeck = 0
return
end if
if( nan3==nan3 ) then
stdlib${ii}$_ieeeck = 0
return
end if
if( nan4==nan4 ) then
stdlib${ii}$_ieeeck = 0
return
end if
if( nan5==nan5 ) then
stdlib${ii}$_ieeeck = 0
return
end if
if( nan6==nan6 ) then
if (ispec == 0) return

if (.not.ieee_support_nan(one)) then
stdlib${ii}$_ieeeck = 0
return
end if

return
end function stdlib${ii}$_ieeeck

Expand Down
Loading