Skip to content

Commit

Permalink
Add a test related to the fix Reference-LAPACK#625
Browse files Browse the repository at this point in the history
  • Loading branch information
weslleyspereira committed Apr 27, 2022
1 parent def1271 commit acd07df
Showing 1 changed file with 48 additions and 0 deletions.
48 changes: 48 additions & 0 deletions TESTING/EIG/schkee.F
Original file line number Diff line number Diff line change
Expand Up @@ -1884,6 +1884,52 @@ PROGRAM SCHKEE
CALL OMP_SET_NUM_THREADS(N_THREADS)
#endif
END IF
*
* Test if SLARRV returns INFO=0 and do not modify the output when
* (N.LE.0).OR.(M.LE.0)
*
* These tests are related to the fix:
* https://github.com/Reference-LAPACK/lapack/pull/625
*
* Test M = 0 on SLARRV:
*
CALL SCOPY( 8, A, 1, WORK, 1 )
IWORK(1) = 100
CALL SLARRV( 1, 1.0E0, 1.0E0, A(1,1), A(2,1),
$ 1.0E0, IWORK(2), 0,
$ 1, 0, 1.0E0, 1.0E0, 1.0E0,
$ A(3,1), A(4,1), A(5,1), IWORK(2),
$ IWORK(2), A(6,1), A(8,1), 5,
$ IWORK(2), A(9,1), IWORK(2), INFO )
IF( INFO.NE.0 ) THEN
WRITE( NOUT, FMT = 9959 )INFO, 'M'
ELSE
DO K = 1, 8
IF( A(K,1) .NE. WORK(K) ) THEN
WRITE( NOUT, FMT = 9958 )'M'
EXIT
END IF
END DO
END IF
*
* Test N = 0 on SLARRV:
*
CALL SCOPY( 1, A, 1, WORK, 1 )
IWORK(1) = 100
CALL SLARRV( 0, 1.0E0, 1.0E0, A, A,
$ 1.0E0, IWORK(2), 1,
$ 1, 0, 1.0E0, 1.0E0, 1.0E0,
$ A, A, A, IWORK(2),
$ IWORK(2), A, A(1,1), 5,
$ IWORK(2), A(2,1), IWORK(2), INFO )
IF( INFO.NE.0 ) THEN
WRITE( NOUT, FMT = 9959 )INFO, 'N'
ELSE
IF( A(1,1) .NE. WORK(1) ) THEN
WRITE( NOUT, FMT = 9958 )'N'
END IF
END IF
*
DO 290 I = 1, NPARMS
CALL XLAENV( 1, NBVAL( I ) )
CALL XLAENV( 2, NBMIN( I ) )
Expand Down Expand Up @@ -2534,6 +2580,8 @@ PROGRAM SCHKEE
$ ', INWIN =', I4, ', INIBL =', I4, ', ISHFTS =', I4,
$ ', IACC22 =', I4)
9960 FORMAT( / ' Tests of the CS Decomposition routines' )
9959 FORMAT( ' SLARRV returns INFO ', I4, ' WHEN ', A, ' = 0' )
9958 FORMAT( ' SLARRV modifies the input WHEN ', A, ' = 0' )
*
* End of SCHKEE
*
Expand Down

0 comments on commit acd07df

Please sign in to comment.