diff --git a/BLAS/TESTING/cblat2.f b/BLAS/TESTING/cblat2.f index cad4405033..abbc26224b 100644 --- a/BLAS/TESTING/cblat2.f +++ b/BLAS/TESTING/cblat2.f @@ -479,7 +479,7 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LCE, LCERES EXTERNAL LCE, LCERES * .. External Subroutines .. - EXTERNAL CGBMV, CGEMV, CMAKE, CMVCH + EXTERNAL CGBMV, CGEMV, CMAKE, CMVCH, CREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -734,6 +734,34 @@ SUBROUTINE CCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL CREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL CGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL CGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LCE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -3219,6 +3247,39 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * * End of CHKXER * + END + SUBROUTINE CREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) +* +* Input initialization for regression test. +* +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + COMPLEX ALPHA, BETA +* .. Array Arguments .. + COMPLEX A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC CMPLX, REAL +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = CMPLX( 1.0 ) + LDA = MAX( 1, M ) + INCX = 1 + BETA = CMPLX( -0.7, -0.8 ) + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = CMPLX( 42.0, REAL( I ) ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) * diff --git a/BLAS/TESTING/dblat2.f b/BLAS/TESTING/dblat2.f index b3e7f0df9f..15d712499b 100644 --- a/BLAS/TESTING/dblat2.f +++ b/BLAS/TESTING/dblat2.f @@ -469,7 +469,7 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LDE, LDERES EXTERNAL LDE, LDERES * .. External Subroutines .. - EXTERNAL DGBMV, DGEMV, DMAKE, DMVCH + EXTERNAL DGBMV, DGEMV, DMAKE, DMVCH, DREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -724,6 +724,34 @@ SUBROUTINE DCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL DREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL DGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL DGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LDE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -3116,6 +3144,39 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * * End of CHKXER * + END + SUBROUTINE DREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) +* +* Input initialization for regression test. +* +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + DOUBLE PRECISION ALPHA, BETA +* .. Array Arguments .. + DOUBLE PRECISION A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC DBLE +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = 1.0D0 + LDA = MAX( 1, M ) + INCX = 1 + BETA = -0.7D0 + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = 42.0D0 + DBLE( I ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) * diff --git a/BLAS/TESTING/sblat2.f b/BLAS/TESTING/sblat2.f index 17962a99cd..01b5c357f1 100644 --- a/BLAS/TESTING/sblat2.f +++ b/BLAS/TESTING/sblat2.f @@ -469,7 +469,7 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LSE, LSERES EXTERNAL LSE, LSERES * .. External Subroutines .. - EXTERNAL SGBMV, SGEMV, SMAKE, SMVCH + EXTERNAL SGBMV, SGEMV, SMAKE, SMVCH, SREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -724,6 +724,34 @@ SUBROUTINE SCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL SREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL SGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL SGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LSE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -3116,6 +3144,39 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * * End of CHKXER * + END + SUBROUTINE SREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) +* +* Input initialization for regression test. +* +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + REAL ALPHA, BETA +* .. Array Arguments .. + REAL A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC REAL +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = 1.0 + LDA = MAX( 1, M ) + INCX = 1 + BETA = -0.7 + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = 42.0 + REAL( I ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) * diff --git a/BLAS/TESTING/zblat2.f b/BLAS/TESTING/zblat2.f index 662ef683b2..07b98f9c1d 100644 --- a/BLAS/TESTING/zblat2.f +++ b/BLAS/TESTING/zblat2.f @@ -481,7 +481,7 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, LOGICAL LZE, LZERES EXTERNAL LZE, LZERES * .. External Subroutines .. - EXTERNAL ZGBMV, ZGEMV, ZMAKE, ZMVCH + EXTERNAL ZGBMV, ZGEMV, ZMAKE, ZMVCH, ZREGR1 * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN * .. Scalars in Common .. @@ -736,6 +736,34 @@ SUBROUTINE ZCHK1( SNAME, EPS, THRESH, NOUT, NTRA, TRACE, REWI, * 120 CONTINUE * +* Regression test to verify preservation of y when m zero, n nonzero. +* + CALL ZREGR1( TRANS, M, N, LY, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY, YS ) + IF( FULL )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9994 )NC, SNAME, TRANS, M, N, ALPHA, LDA, + $ INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL ZGEMV( TRANS, M, N, ALPHA, AA, LDA, XX, INCX, BETA, YY, + $ INCY ) + ELSE IF( BANDED )THEN + IF( TRACE ) + $ WRITE( NTRA, FMT = 9995 )NC, SNAME, TRANS, M, N, KL, KU, + $ ALPHA, LDA, INCX, BETA, INCY + IF( REWI ) + $ REWIND NTRA + CALL ZGBMV( TRANS, M, N, KL, KU, ALPHA, AA, LDA, XX, INCX, + $ BETA, YY, INCY ) + END IF + NC = NC + 1 + IF( .NOT.LZE( YS, YY, LY ) )THEN + WRITE( NOUT, FMT = 9998 )NARGS - 1 + FATAL = .TRUE. + GO TO 130 + END IF +* * Report result. * IF( ERRMAX.LT.THRESH )THEN @@ -3227,6 +3255,39 @@ SUBROUTINE CHKXER( SRNAMT, INFOT, NOUT, LERR, OK ) * * End of CHKXER * + END + SUBROUTINE ZREGR1( TRANS, M, N, LY, KL, KU, ALPHA, A, LDA, X, + $ INCX, BETA, Y, INCY, YS ) +* +* Input initialization for regression test. +* +* .. Scalar Arguments .. + CHARACTER*1 TRANS + INTEGER LY, M, N, KL, KU, LDA, INCX, INCY + COMPLEX*16 ALPHA, BETA +* .. Array Arguments .. + COMPLEX*16 A(LDA,*), X(*), Y(*), YS(*) +* .. Local Scalars .. + INTEGER I +* .. Intrinsic Functions .. + INTRINSIC DBLE, DCMPLX +* .. Executable Statements .. + TRANS = 'T' + M = 0 + N = 5 + KL = 0 + KU = 0 + ALPHA = DCMPLX( 1.0D0 ) + LDA = MAX( 1, M ) + INCX = 1 + BETA = DCMPLX( -0.7D0, -0.8D0 ) + INCY = 1 + LY = ABS( INCY )*N + DO 10 I = 1, LY + Y( I ) = DCMPLX( 42.0D0, DBLE( I ) ) + YS( I ) = Y( I ) + 10 CONTINUE + RETURN END SUBROUTINE XERBLA( SRNAME, INFO ) *