1 SUBROUTINE dlaror( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
9 INTEGER info, lda, m, n
13 DOUBLE PRECISION a( lda, * ), x( * )
100 DOUBLE PRECISION zero, one, toosml
101 parameter( zero = 0.0d+0, one = 1.0d+0,
105 INTEGER irow,
itype, ixfrm, j, jcol, kbeg, nxfrm
106 DOUBLE PRECISION factor, xnorm, xnorms
110 DOUBLE PRECISION dlarnd, dnrm2
111 EXTERNAL lsame,
dlarnd, dnrm2
121 IF( n.EQ.0 .OR. m.EQ.0 )
125 IF( lsame(
side,
'L' ) )
THEN
127 ELSE IF( lsame(
side,
'R' ) )
THEN
129 ELSE IF( lsame(
side,
'C' ) .OR. lsame(
side,
'T' ) )
THEN
136 IF(
itype.EQ.0 )
THEN
138 ELSE IF( m.LT.0 )
THEN
140 ELSE IF( n.LT.0 .OR. (
itype.EQ.3 .AND. n.NE.m ) )
THEN
142 ELSE IF( lda.LT.m )
THEN
146 CALL
xerbla(
'DLAROR', -info )
150 IF(
itype.EQ.1 )
THEN
158 IF( lsame( init,
'I' ) )
159 $ CALL
dlaset(
'Full', m, n, zero, one, a, lda )
170 DO 30 ixfrm = 2, nxfrm
171 kbeg = nxfrm - ixfrm + 1
175 DO 20 j = kbeg, nxfrm
176 x( j ) =
dlarnd( 3, iseed )
181 xnorm = dnrm2( ixfrm, x( kbeg ), 1 )
182 xnorms = sign( xnorm, x( kbeg ) )
183 x( kbeg+nxfrm ) = sign( one, -x( kbeg ) )
184 factor = xnorms*( xnorms+x( kbeg ) )
185 IF( abs(
factor ).LT.toosml )
THEN
187 CALL
xerbla(
'DLAROR', info )
192 x( kbeg ) = x( kbeg ) + xnorms
200 CALL dgemv(
'T', ixfrm, n, one, a( kbeg, 1 ), lda,
201 $ x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
202 CALL dger( ixfrm, n, -
factor, x( kbeg ), 1, x( 2*nxfrm+1 ),
203 $ 1, a( kbeg, 1 ), lda )
211 CALL dgemv(
'N', m, ixfrm, one, a( 1, kbeg ), lda,
212 $ x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
213 CALL dger( m, ixfrm, -
factor, x( 2*nxfrm+1 ), 1, x( kbeg ),
214 $ 1, a( 1, kbeg ), lda )
219 x( 2*nxfrm ) = sign( one,
dlarnd( 3, iseed ) )
225 CALL dscal( n, x( nxfrm+irow ), a( irow, 1 ), lda )
231 CALL dscal( m, x( nxfrm+jcol ), a( 1, jcol ), 1 )