From d2d2625019efa1ef793a15badaed713c39ce716d Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Thu, 2 Oct 2025 16:40:58 +0200 Subject: [PATCH 1/3] Disable constant propagation for the NAG Fortran compiler in BLAS tests. --- BLAS/TESTING/CMakeLists.txt | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/BLAS/TESTING/CMakeLists.txt b/BLAS/TESTING/CMakeLists.txt index ae82cf937f..597e81738b 100644 --- a/BLAS/TESTING/CMakeLists.txt +++ b/BLAS/TESTING/CMakeLists.txt @@ -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) From 362029e38387afd443b2dd66179ed9e6126d4a4f Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Thu, 2 Oct 2025 16:41:30 +0200 Subject: [PATCH 2/3] Add missing intrinsics in icamax.f90 and izamax.f90 --- BLAS/SRC/icamax.f90 | 25 ++++++++++++++----------- BLAS/SRC/izamax.f90 | 25 ++++++++++++++----------- 2 files changed, 28 insertions(+), 22 deletions(-) diff --git a/BLAS/SRC/icamax.f90 b/BLAS/SRC/icamax.f90 index a53cb1c4a9..9be0d9fdaa 100644 --- a/BLAS/SRC/icamax.f90 +++ b/BLAS/SRC/icamax.f90 @@ -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 ! @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/BLAS/SRC/izamax.f90 b/BLAS/SRC/izamax.f90 index 02d97dcf9e..35b81d741c 100644 --- a/BLAS/SRC/izamax.f90 +++ b/BLAS/SRC/izamax.f90 @@ -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 ! @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 From 9630b23c4f34e631c3b6352718f56a4cf8478c79 Mon Sep 17 00:00:00 2001 From: Simon Maertens Date: Thu, 2 Oct 2025 16:42:00 +0200 Subject: [PATCH 3/3] Fixed FORMAT lines that were longerthan 72 characters --- CBLAS/testing/c_dblat3.f | 12 ++++++------ CBLAS/testing/c_sblat3.f | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/CBLAS/testing/c_dblat3.f b/CBLAS/testing/c_dblat3.f index 7d7c8e721e..9d8f0bb819 100644 --- a/CBLAS/testing/c_dblat3.f +++ b/CBLAS/testing/c_dblat3.f @@ -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 *', $ '******' ) * diff --git a/CBLAS/testing/c_sblat3.f b/CBLAS/testing/c_sblat3.f index 15a5c1d05e..f9277655ac 100644 --- a/CBLAS/testing/c_sblat3.f +++ b/CBLAS/testing/c_sblat3.f @@ -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 *', $ '******' ) *