147 SUBROUTINE slaror( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
156 INTEGER INFO, LDA, M, N
160 REAL A( lda, * ), X( * )
166 REAL ZERO, ONE, TOOSML
167 parameter ( zero = 0.0e+0, one = 1.0e+0,
171 INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM
172 REAL FACTOR, XNORM, XNORMS
177 EXTERNAL lsame, slarnd, snrm2
188 IF( n.EQ.0 .OR. m.EQ.0 )
192 IF( lsame( side,
'L' ) )
THEN
194 ELSE IF( lsame( side,
'R' ) )
THEN
196 ELSE IF( lsame( side,
'C' ) .OR. lsame( side,
'T' ) )
THEN
202 IF( itype.EQ.0 )
THEN
204 ELSE IF( m.LT.0 )
THEN
206 ELSE IF( n.LT.0 .OR. ( itype.EQ.3 .AND. n.NE.m ) )
THEN
208 ELSE IF( lda.LT.m )
THEN
212 CALL xerbla(
'SLAROR', -info )
216 IF( itype.EQ.1 )
THEN
224 IF( lsame( init,
'I' ) )
225 $
CALL slaset(
'Full', m, n, zero, one, a, lda )
236 DO 30 ixfrm = 2, nxfrm
237 kbeg = nxfrm - ixfrm + 1
241 DO 20 j = kbeg, nxfrm
242 x( j ) = slarnd( 3, iseed )
247 xnorm = snrm2( ixfrm, x( kbeg ), 1 )
248 xnorms = sign( xnorm, x( kbeg ) )
249 x( kbeg+nxfrm ) = sign( one, -x( kbeg ) )
250 factor = xnorms*( xnorms+x( kbeg ) )
251 IF( abs( factor ).LT.toosml )
THEN
253 CALL xerbla(
'SLAROR', info )
256 factor = one / factor
258 x( kbeg ) = x( kbeg ) + xnorms
262 IF( itype.EQ.1 .OR. itype.EQ.3 )
THEN
266 CALL sgemv(
'T', ixfrm, n, one, a( kbeg, 1 ), lda,
267 $ x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
268 CALL sger( ixfrm, n, -factor, x( kbeg ), 1, x( 2*nxfrm+1 ),
269 $ 1, a( kbeg, 1 ), lda )
273 IF( itype.EQ.2 .OR. itype.EQ.3 )
THEN
277 CALL sgemv(
'N', m, ixfrm, one, a( 1, kbeg ), lda,
278 $ x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
279 CALL sger( m, ixfrm, -factor, x( 2*nxfrm+1 ), 1, x( kbeg ),
280 $ 1, a( 1, kbeg ), lda )
285 x( 2*nxfrm ) = sign( one, slarnd( 3, iseed ) )
289 IF( itype.EQ.1 .OR. itype.EQ.3 )
THEN
291 CALL sscal( n, x( nxfrm+irow ), a( irow, 1 ), lda )
295 IF( itype.EQ.2 .OR. itype.EQ.3 )
THEN
297 CALL sscal( m, x( nxfrm+jcol ), a( 1, jcol ), 1 )
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine slaror(SIDE, INIT, M, N, A, LDA, ISEED, X, INFO)
SLAROR
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine sscal(N, SA, SX, INCX)
SSCAL