Skip to content

Commit c08dcfa

Browse files
langoulangou
authored
Merge pull request #1159 from ACSimon33/nagfor_constant_propagation_fix
Fixes for the NAG Fortran compiler
2 parents 66380df + 9630b23 commit c08dcfa

File tree

5 files changed

+46
-34
lines changed

5 files changed

+46
-34
lines changed

‎BLAS/SRC/icamax.f90‎

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -86,6 +86,9 @@ integer function icamax(n, x, incx)
8686
integer :: i, j, ix, jx
8787
real(wp) :: val, smax
8888
logical :: scaledsmax
89+
! ..
90+
! .. Intrinsic Functions ..
91+
intrinsic :: abs, aimag, huge, real
8992
!
9093
! Quick return if possible
9194
!
@@ -100,7 +103,7 @@ integer function icamax(n, x, incx)
100103
smax = -1
101104
!
102105
! scaledsmax = .true. indicates that x(icamax) is finite but
103-
! abs(real(x(icamax))) + abs(imag(x(icamax))) overflows
106+
! abs(real(x(icamax))) + abs(aimag(x(icamax))) overflows
104107
!
105108
if (incx == 1) then
106109
! code for increment equal to 1
@@ -109,7 +112,7 @@ integer function icamax(n, x, incx)
109112
! return when first NaN found
110113
icamax = i
111114
return
112-
elseif (abs(real(x(i))) > hugeval .or. abs(imag(x(i))) > hugeval) then
115+
elseif (abs(real(x(i))) > hugeval .or. abs(aimag(x(i))) > hugeval) then
113116
! keep looking for first NaN
114117
do j = i+1, n
115118
if (x(j) /= x(j)) then
@@ -123,18 +126,18 @@ integer function icamax(n, x, incx)
123126
return
124127
else ! still no Inf found yet
125128
if (.not. scaledsmax) then
126-
! no abs(real(x(i))) + abs(imag(x(i))) = Inf yet
127-
val = abs(real(x(i))) + abs(imag(x(i)))
129+
! no abs(real(x(i))) + abs(aimag(x(i))) = Inf yet
130+
val = abs(real(x(i))) + abs(aimag(x(i)))
128131
if (val > hugeval) then
129132
scaledsmax = .true.
130-
smax = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
133+
smax = 0.25*abs(real(x(i))) + 0.25*abs(aimag(x(i)))
131134
icamax = i
132135
elseif (val > smax) then ! everything finite so far
133136
smax = val
134137
icamax = i
135138
endif
136139
else ! scaledsmax
137-
val = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
140+
val = 0.25*abs(real(x(i))) + 0.25*abs(aimag(x(i)))
138141
if (val > smax) then
139142
smax = val
140143
icamax = i
@@ -150,7 +153,7 @@ integer function icamax(n, x, incx)
150153
! return when first NaN found
151154
icamax = i
152155
return
153-
elseif (abs(real(x(ix))) > hugeval .or. abs(imag(x(ix))) > hugeval) then
156+
elseif (abs(real(x(ix))) > hugeval .or. abs(aimag(x(ix))) > hugeval) then
154157
! keep looking for first NaN
155158
jx = ix + incx
156159
do j = i+1, n
@@ -166,18 +169,18 @@ integer function icamax(n, x, incx)
166169
return
167170
else ! still no Inf found yet
168171
if (.not. scaledsmax) then
169-
! no abs(real(x(ix))) + abs(imag(x(ix))) = Inf yet
170-
val = abs(real(x(ix))) + abs(imag(x(ix)))
172+
! no abs(real(x(ix))) + abs(aimag(x(ix))) = Inf yet
173+
val = abs(real(x(ix))) + abs(aimag(x(ix)))
171174
if (val > hugeval) then
172175
scaledsmax = .true.
173-
smax = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
176+
smax = 0.25*abs(real(x(ix))) + 0.25*abs(aimag(x(ix)))
174177
icamax = i
175178
elseif (val > smax) then ! everything finite so far
176179
smax = val
177180
icamax = i
178181
endif
179182
else ! scaledsmax
180-
val = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
183+
val = 0.25*abs(real(x(ix))) + 0.25*abs(aimag(x(ix)))
181184
if (val > smax) then
182185
smax = val
183186
icamax = i

‎BLAS/SRC/izamax.f90‎

Lines changed: 14 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -86,6 +86,9 @@ integer function izamax(n, x, incx)
8686
integer :: i, j, ix, jx
8787
real(wp) :: val, smax
8888
logical :: scaledsmax
89+
! ..
90+
! .. Intrinsic Functions ..
91+
intrinsic :: abs, dimag, huge, real
8992
!
9093
! Quick return if possible
9194
!
@@ -100,7 +103,7 @@ integer function izamax(n, x, incx)
100103
smax = -1
101104
!
102105
! scaledsmax = .true. indicates that x(izamax) is finite but
103-
! abs(real(x(izamax))) + abs(imag(x(izamax))) overflows
106+
! abs(real(x(izamax))) + abs(dimag(x(izamax))) overflows
104107
!
105108
if (incx == 1) then
106109
! code for increment equal to 1
@@ -109,7 +112,7 @@ integer function izamax(n, x, incx)
109112
! return when first NaN found
110113
izamax = i
111114
return
112-
elseif (abs(real(x(i))) > hugeval .or. abs(imag(x(i))) > hugeval) then
115+
elseif (abs(real(x(i))) > hugeval .or. abs(dimag(x(i))) > hugeval) then
113116
! keep looking for first NaN
114117
do j = i+1, n
115118
if (x(j) /= x(j)) then
@@ -123,18 +126,18 @@ integer function izamax(n, x, incx)
123126
return
124127
else ! still no Inf found yet
125128
if (.not. scaledsmax) then
126-
! no abs(real(x(i))) + abs(imag(x(i))) = Inf yet
127-
val = abs(real(x(i))) + abs(imag(x(i)))
129+
! no abs(real(x(i))) + abs(dimag(x(i))) = Inf yet
130+
val = abs(real(x(i))) + abs(dimag(x(i)))
128131
if (val > hugeval) then
129132
scaledsmax = .true.
130-
smax = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
133+
smax = 0.25*abs(real(x(i))) + 0.25*abs(dimag(x(i)))
131134
izamax = i
132135
elseif (val > smax) then ! everything finite so far
133136
smax = val
134137
izamax = i
135138
endif
136139
else ! scaledsmax
137-
val = 0.25*abs(real(x(i))) + 0.25*abs(imag(x(i)))
140+
val = 0.25*abs(real(x(i))) + 0.25*abs(dimag(x(i)))
138141
if (val > smax) then
139142
smax = val
140143
izamax = i
@@ -150,7 +153,7 @@ integer function izamax(n, x, incx)
150153
! return when first NaN found
151154
izamax = i
152155
return
153-
elseif (abs(real(x(ix))) > hugeval .or. abs(imag(x(ix))) > hugeval) then
156+
elseif (abs(real(x(ix))) > hugeval .or. abs(dimag(x(ix))) > hugeval) then
154157
! keep looking for first NaN
155158
jx = ix + incx
156159
do j = i+1, n
@@ -166,18 +169,18 @@ integer function izamax(n, x, incx)
166169
return
167170
else ! still no Inf found yet
168171
if (.not. scaledsmax) then
169-
! no abs(real(x(ix))) + abs(imag(x(ix))) = Inf yet
170-
val = abs(real(x(ix))) + abs(imag(x(ix)))
172+
! no abs(real(x(ix))) + abs(dimag(x(ix))) = Inf yet
173+
val = abs(real(x(ix))) + abs(dimag(x(ix)))
171174
if (val > hugeval) then
172175
scaledsmax = .true.
173-
smax = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
176+
smax = 0.25*abs(real(x(ix))) + 0.25*abs(dimag(x(ix)))
174177
izamax = i
175178
elseif (val > smax) then ! everything finite so far
176179
smax = val
177180
izamax = i
178181
endif
179182
else ! scaledsmax
180-
val = 0.25*abs(real(x(ix))) + 0.25*abs(imag(x(ix)))
183+
val = 0.25*abs(real(x(ix))) + 0.25*abs(dimag(x(ix)))
181184
if (val > smax) then
182185
smax = val
183186
izamax = i

‎BLAS/TESTING/CMakeLists.txt‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,12 @@ macro(add_blas_test name src)
1515
-DINTDIR=${CMAKE_CFG_INTDIR}
1616
-P "${LAPACK_SOURCE_DIR}/TESTING/runtest.cmake")
1717
endif()
18+
19+
# Disable constant propagation for NAG compiler to avoid issues with
20+
# special values (Inf, NaN) returned by SXVALS and DXVALS.
21+
if(CMAKE_Fortran_COMPILER_ID STREQUAL "NAG")
22+
target_compile_options(${name} PRIVATE "-Onopropagate")
23+
endif()
1824
endmacro()
1925

2026
if(BUILD_SINGLE)

‎CBLAS/testing/c_dblat3.f‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2821,13 +2821,13 @@ SUBROUTINE DCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
28212821
$ ' (', I6, ' CALL', 'S)' )
28222822
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
28232823
$ 'ANGED INCORRECTLY *******' )
2824-
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
2825-
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
2826-
$ ' - SUSPECT *******' )
2824+
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6,
2825+
$ ' C', 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO',
2826+
$ F8.2, ' - SUSPECT *******' )
28272827
9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' )
2828-
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',',
2829-
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
2830-
$ 'C,', I3, ').' )
2828+
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,
2829+
$ ''',', 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
2830+
$ F4.1, ', ', 'C,', I3, ').' )
28312831
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
28322832
$ '******' )
28332833
*

‎CBLAS/testing/c_sblat3.f‎

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2822,13 +2822,13 @@ SUBROUTINE SCHK6( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI,
28222822
$ ' (', I6, ' CALL', 'S)' )
28232823
9998 FORMAT( ' ******* FATAL ERROR - PARAMETER NUMBER ', I2, ' WAS CH',
28242824
$ 'ANGED INCORRECTLY *******' )
2825-
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6, ' C',
2826-
$ 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO', F8.2,
2827-
$ ' - SUSPECT *******' )
2825+
9997 FORMAT( ' ', A13, ' COMPLETED THE COMPUTATIONAL TESTS (', I6,
2826+
$ ' C', 'ALLS)', /' ******* BUT WITH MAXIMUM TEST RATIO',
2827+
$ F8.2, ' - SUSPECT *******' )
28282828
9996 FORMAT( ' ******* ', A13, ' FAILED ON CALL NUMBER:' )
2829-
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,''',',
2830-
$ 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',', F4.1, ', ',
2831-
$ 'C,', I3, ').' )
2829+
9995 FORMAT( 1X, I6, ': ', A13, '(''',A1, ''',''',A1, ''',''', A1,
2830+
$ ''',', 2( I3, ',' ), F4.1, ', A,', I3, ', B,', I3, ',',
2831+
$ F4.1, ', ', 'C,', I3, ').' )
28322832
9994 FORMAT( ' ******* FATAL ERROR - ERROR-EXIT TAKEN ON VALID CALL *',
28332833
$ '******' )
28342834
*

0 commit comments

Comments
 (0)