147 SUBROUTINE dlaror( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
156 INTEGER info, lda, m, n
160 DOUBLE PRECISION a( lda, * ),
x( * )
166 DOUBLE PRECISION zero, one, toosml
167 parameter( zero = 0.0d+0, one = 1.0d+0,
171 INTEGER irow, itype, ixfrm,
j, jcol, kbeg, nxfrm
172 DOUBLE PRECISION factor, xnorm, xnorms
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(
'DLAROR', -info )
216 IF( itype.EQ.1 )
THEN
224 IF(
lsame( init,
'I' ) )
225 $ CALL
dlaset(
'Full', m, n, zero, one, a, lda )
236 DO 30 ixfrm = 2, nxfrm
237 kbeg = nxfrm - ixfrm + 1
241 DO 20
j = kbeg, nxfrm
247 xnorm =
dnrm2( 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(
'DLAROR', info )
256 factor = one / factor
258 x( kbeg ) =
x( kbeg ) + xnorms
262 IF( itype.EQ.1 .OR. itype.EQ.3 )
THEN
266 CALL
dgemv(
'T', ixfrm, n, one, a( kbeg, 1 ), lda,
267 $
x( kbeg ), 1, zero,
x( 2*nxfrm+1 ), 1 )
268 CALL
dger( 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
dgemv(
'N', m, ixfrm, one, a( 1, kbeg ), lda,
278 $
x( kbeg ), 1, zero,
x( 2*nxfrm+1 ), 1 )
279 CALL
dger( m, ixfrm, -factor,
x( 2*nxfrm+1 ), 1,
x( kbeg ),
280 $ 1, a( 1, kbeg ), lda )
285 x( 2*nxfrm ) = sign( one,
dlarnd( 3, iseed ) )
289 IF( itype.EQ.1 .OR. itype.EQ.3 )
THEN
291 CALL
dscal( n,
x( nxfrm+irow ), a( irow, 1 ), lda )
295 IF( itype.EQ.2 .OR. itype.EQ.3 )
THEN
297 CALL
dscal( m,
x( nxfrm+jcol ), a( 1, jcol ), 1 )
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
DOUBLE PRECISION function dlarnd(IDIST, ISEED)
DLARND
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine dlaror(SIDE, INIT, M, N, A, LDA, ISEED, X, INFO)
DLAROR
DOUBLE PRECISION function dnrm2(N, X, INCX)
DNRM2
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV