Skip to content

Fixes for the NAG Fortran compiler #1159

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

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Fixes for the NAG Fortran compiler #1159

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
d2d2625
Disable constant propagation for the NAG Fortran compiler in BLAS tests.
ACSimon33 Oct 2, 2025
362029e
Add missing intrinsics in icamax.f90 and izamax.f90
ACSimon33 Oct 2, 2025
9630b23
Fixed FORMAT lines that were longerthan 72 characters
ACSimon33 Oct 2, 2025
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
25 changes: 14 additions & 11 deletions BLAS/SRC/icamax.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,9 @@ integer function icamax(n, x, incx)
integer :: i, j, ix, jx
real(wp) :: val, smax
logical :: scaledsmax
! ..
! .. Intrinsic Functions ..
intrinsic :: abs, aimag, huge, real
!
! Quick return if possible
!
Expand All @@ -100,7 +103,7 @@ integer function icamax(n, x, incx)
smax = -1
!
! scaledsmax = .true. indicates that x(icamax) is finite but
! abs(real(x(icamax))) + abs(imag(x(icamax))) overflows
! abs(real(x(icamax))) + abs(aimag(x(icamax))) overflows
!
if (incx == 1) then
! code for increment equal to 1
Expand All @@ -109,7 +112,7 @@ integer function icamax(n, x, incx)
! return when first NaN found
icamax = i
return
elseif (abs(real(x(i))) > hugeval .or. abs(imag(x(i))) > hugeval) then
elseif (abs(real(x(i))) > hugeval .or. abs(aimag(x(i))) > hugeval) then
! keep looking for first NaN
do j = i+1, n
if (x(j) /= x(j)) then
Expand All @@ -123,18 +126,18 @@ integer function icamax(n, x, incx)
return
else ! still no Inf found yet
if (.not. scaledsmax) then
! no abs(real(x(i))) + abs(imag(x(i))) = Inf yet
val = abs(real(x(i))) + abs(imag(x(i)))
! no abs(real(x(i))) + abs(aimag(x(i))) = Inf yet
val = abs(real(x(i))) + abs(aimag(x(i)))
if (val > hugeval) then
scaledsmax = .true.
smax = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
smax = 0.25*abs(real(x(i))) + 0.25*abs(aimag(x(i)))
icamax = i
elseif (val > smax) then ! everything finite so far
smax = val
icamax = i
endif
else ! scaledsmax
val = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
val = 0.25*abs(real(x(i))) + 0.25*abs(aimag(x(i)))
if (val > smax) then
smax = val
icamax = i
Expand All @@ -150,7 +153,7 @@ integer function icamax(n, x, incx)
! return when first NaN found
icamax = i
return
elseif (abs(real(x(ix))) > hugeval .or. abs(imag(x(ix))) > hugeval) then
elseif (abs(real(x(ix))) > hugeval .or. abs(aimag(x(ix))) > hugeval) then
! keep looking for first NaN
jx = ix + incx
do j = i+1, n
Expand All @@ -166,18 +169,18 @@ integer function icamax(n, x, incx)
return
else ! still no Inf found yet
if (.not. scaledsmax) then
! no abs(real(x(ix))) + abs(imag(x(ix))) = Inf yet
val = abs(real(x(ix))) + abs(imag(x(ix)))
! no abs(real(x(ix))) + abs(aimag(x(ix))) = Inf yet
val = abs(real(x(ix))) + abs(aimag(x(ix)))
if (val > hugeval) then
scaledsmax = .true.
smax = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
smax = 0.25*abs(real(x(ix))) + 0.25*abs(aimag(x(ix)))
icamax = i
elseif (val > smax) then ! everything finite so far
smax = val
icamax = i
endif
else ! scaledsmax
val = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
val = 0.25*abs(real(x(ix))) + 0.25*abs(aimag(x(ix)))
if (val > smax) then
smax = val
icamax = i
Expand Down
25 changes: 14 additions & 11 deletions BLAS/SRC/izamax.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,9 @@ integer function izamax(n, x, incx)
integer :: i, j, ix, jx
real(wp) :: val, smax
logical :: scaledsmax
! ..
! .. Intrinsic Functions ..
intrinsic :: abs, dimag, huge, real
!
! Quick return if possible
!
Expand All @@ -100,7 +103,7 @@ integer function izamax(n, x, incx)
smax = -1
!
! scaledsmax = .true. indicates that x(izamax) is finite but
! abs(real(x(izamax))) + abs(imag(x(izamax))) overflows
! abs(real(x(izamax))) + abs(dimag(x(izamax))) overflows
!
if (incx == 1) then
! code for increment equal to 1
Expand All @@ -109,7 +112,7 @@ integer function izamax(n, x, incx)
! return when first NaN found
izamax = i
return
elseif (abs(real(x(i))) > hugeval .or. abs(imag(x(i))) > hugeval) then
elseif (abs(real(x(i))) > hugeval .or. abs(dimag(x(i))) > hugeval) then
! keep looking for first NaN
do j = i+1, n
if (x(j) /= x(j)) then
Expand All @@ -123,18 +126,18 @@ integer function izamax(n, x, incx)
return
else ! still no Inf found yet
if (.not. scaledsmax) then
! no abs(real(x(i))) + abs(imag(x(i))) = Inf yet
val = abs(real(x(i))) + abs(imag(x(i)))
! no abs(real(x(i))) + abs(dimag(x(i))) = Inf yet
val = abs(real(x(i))) + abs(dimag(x(i)))
if (val > hugeval) then
scaledsmax = .true.
smax = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
smax = 0.25*abs(real(x(i))) + 0.25*abs(dimag(x(i)))
izamax = i
elseif (val > smax) then ! everything finite so far
smax = val
izamax = i
endif
else ! scaledsmax
val = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
val = 0.25*abs(real(x(i))) + 0.25*abs(dimag(x(i)))
if (val > smax) then
smax = val
izamax = i
Expand All @@ -150,7 +153,7 @@ integer function izamax(n, x, incx)
! return when first NaN found
izamax = i
return
elseif (abs(real(x(ix))) > hugeval .or. abs(imag(x(ix))) > hugeval) then
elseif (abs(real(x(ix))) > hugeval .or. abs(dimag(x(ix))) > hugeval) then
! keep looking for first NaN
jx = ix + incx
do j = i+1, n
Expand All @@ -166,18 +169,18 @@ integer function izamax(n, x, incx)
return
else ! still no Inf found yet
if (.not. scaledsmax) then
! no abs(real(x(ix))) + abs(imag(x(ix))) = Inf yet
val = abs(real(x(ix))) + abs(imag(x(ix)))
! no abs(real(x(ix))) + abs(dimag(x(ix))) = Inf yet
val = abs(real(x(ix))) + abs(dimag(x(ix)))
if (val > hugeval) then
scaledsmax = .true.
smax = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
smax = 0.25*abs(real(x(ix))) + 0.25*abs(dimag(x(ix)))
izamax = i
elseif (val > smax) then ! everything finite so far
smax = val
izamax = i
endif
else ! scaledsmax
val = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
val = 0.25*abs(real(x(ix))) + 0.25*abs(dimag(x(ix)))
if (val > smax) then
smax = val
izamax = i
Expand Down
6 changes: 6 additions & 0 deletions BLAS/TESTING/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,12 @@ macro(add_blas_test name src)
-DINTDIR=${CMAKE_CFG_INTDIR}
-P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
endif()

# Disable constant propagation for NAG compiler to avoid issues with
# special values (Inf, NaN) returned by SXVALS and DXVALS.
if(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG")
target_compile_options(${name} PRIVATE "-Onopropagate")
endif()
endmacro()

if(BUILD_SINGLE)
Expand Down
12 changes: 6 additions & 6 deletions CBLAS/testing/c_dblat3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2821,13 +2821,13 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
$ ' (', I6, ' CALL', 'S)' )
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
$ 'ANGED INCORRECTLY *******' )
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
$ ' - SUSPECT *******' )
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6,
$ ' C', 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO',
$ F8.2, ' - SUSPECT *******' )
9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' )
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',',
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
$ 'C,', I3, ').' )
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,
$ ''',', 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
$ F4.1, ', ', 'C,', I3, ').' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
$ '******' )
*
Expand Down
12 changes: 6 additions & 6 deletions CBLAS/testing/c_sblat3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2822,13 +2822,13 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
$ ' (', I6, ' CALL', 'S)' )
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
$ 'ANGED INCORRECTLY *******' )
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
$ ' - SUSPECT *******' )
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6,
$ ' C', 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO',
$ F8.2, ' - SUSPECT *******' )
9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' )
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',',
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
$ 'C,', I3, ').' )
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,
$ ''',', 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
$ F4.1, ', ', 'C,', I3, ').' )
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
$ '******' )
*
Expand Down