Skip to content

Commit 02bdea9

Browse files
Add a test related to the fix Reference-LAPACK#625
1 parent def1271 commit 02bdea9

File tree

1 file changed

+50
-1
lines changed

1 file changed

+50
-1
lines changed

TESTING/EIG/schkee.F

Lines changed: 50 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1111,7 +1111,7 @@ PROGRAM SCHKEE
11111111
$ SDRGEV, SDRGSX, SDRGVX, SDRVBD, SDRVES, SDRVEV,
11121112
$ SDRVSG, SDRVST, SDRVSX, SDRVVX, SERRBD,
11131113
$ SERRED, SERRGG, SERRHS, SERRST, ILAVER, XLAENV,
1114-
$ SDRGES3, SDRGEV3,
1114+
$ SDRGES3, SDRGEV3, SLARRV
11151115
$ SCHKST2STG, SDRVST2STG, SCHKSB2STG, SDRVSG2STG
11161116
* ..
11171117
* .. Intrinsic Functions ..
@@ -1884,6 +1884,52 @@ PROGRAM SCHKEE
18841884
CALL OMP_SET_NUM_THREADS(N_THREADS)
18851885
#endif
18861886
END IF
1887+
*
1888+
* Test if SLARRV returns INFO=0 and do not modify the output when
1889+
* (N.LE.0).OR.(M.LE.0)
1890+
*
1891+
* These tests are related to the fix:
1892+
* https://github.com/Reference-LAPACK/lapack/pull/625
1893+
*
1894+
* Test M = 0 on SLARRV:
1895+
*
1896+
CALL SCOPY( 8, A, 1, WORK, 1 )
1897+
IWORK(1) = 100
1898+
CALL SLARRV( 1, 1.0E0, 1.0E0, A(1,1), A(2,1),
1899+
$ 1.0E0, IWORK(2), 0,
1900+
$ 1, 0, 1.0E0, 1.0E0, 1.0E0,
1901+
$ A(3,1), A(4,1), A(5,1), IWORK(2),
1902+
$ IWORK(2), A(6,1), A(8,1), 5,
1903+
$ IWORK(2), A(9,1), IWORK(2), INFO )
1904+
IF( INFO.NE.0 ) THEN
1905+
WRITE( NOUT, FMT = 9959 )INFO, 'M'
1906+
ELSE
1907+
DO K = 1, 8
1908+
IF( A(K,1) .NE. WORK(K) ) THEN
1909+
WRITE( NOUT, FMT = 9958 )'M'
1910+
EXIT
1911+
END IF
1912+
END DO
1913+
END IF
1914+
*
1915+
* Test N = 0 on SLARRV:
1916+
*
1917+
CALL SCOPY( 1, A, 1, WORK, 1 )
1918+
IWORK(1) = 100
1919+
CALL SLARRV( 0, 1.0E0, 1.0E0, A, A,
1920+
$ 1.0E0, IWORK(2), 1,
1921+
$ 1, 0, 1.0E0, 1.0E0, 1.0E0,
1922+
$ A, A, A, IWORK(2),
1923+
$ IWORK(2), A, A(1,1), 5,
1924+
$ IWORK(2), A(2,1), IWORK(2), INFO )
1925+
IF( INFO.NE.0 ) THEN
1926+
WRITE( NOUT, FMT = 9959 )INFO, 'N'
1927+
ELSE
1928+
IF( A(1,1) .NE. WORK(1) ) THEN
1929+
WRITE( NOUT, FMT = 9958 )'N'
1930+
END IF
1931+
END IF
1932+
*
18871933
DO 290 I = 1, NPARMS
18881934
CALL XLAENV( 1, NBVAL( I ) )
18891935
CALL XLAENV( 2, NBMIN( I ) )
@@ -2534,6 +2580,9 @@ PROGRAM SCHKEE
25342580
$ ', INWIN =', I4, ', INIBL =', I4, ', ISHFTS =', I4,
25352581
$ ', IACC22 =', I4)
25362582
9960 FORMAT( / ' Tests of the CS Decomposition routines' )
2583+
9959 FORMAT( ' SLARRV returned INFO ', I4, ' WHEN ', A, ' = 0' )
2584+
9958 FORMAT( ' SLARRV returned INFO 0 but modified the input WHEN '
2585+
$ , A, ' = 0' )
25372586
*
25382587
* End of SCHKEE
25392588
*

0 commit comments

Comments
 (0)