@@ -1111,7 +1111,7 @@ PROGRAM SCHKEE
1111
1111
$ SDRGEV, SDRGSX, SDRGVX, SDRVBD, SDRVES, SDRVEV,
1112
1112
$ SDRVSG, SDRVST, SDRVSX, SDRVVX, SERRBD,
1113
1113
$ SERRED, SERRGG, SERRHS, SERRST, ILAVER, XLAENV,
1114
- $ SDRGES3, SDRGEV3,
1114
+ $ SDRGES3, SDRGEV3, SLARRV
1115
1115
$ SCHKST2STG, SDRVST2STG, SCHKSB2STG, SDRVSG2STG
1116
1116
* ..
1117
1117
* .. Intrinsic Functions ..
@@ -1884,6 +1884,52 @@ PROGRAM SCHKEE
1884
1884
CALL OMP_SET_NUM_THREADS(N_THREADS)
1885
1885
#endif
1886
1886
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
+ *
1887
1933
DO 290 I = 1 , NPARMS
1888
1934
CALL XLAENV( 1 , NBVAL( I ) )
1889
1935
CALL XLAENV( 2 , NBMIN( I ) )
@@ -2534,6 +2580,9 @@ PROGRAM SCHKEE
2534
2580
$ ' , INWIN =' , I4, ' , INIBL =' , I4, ' , ISHFTS =' , I4,
2535
2581
$ ' , IACC22 =' , I4)
2536
2582
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' )
2537
2586
*
2538
2587
* End of SCHKEE
2539
2588
*
0 commit comments