159 SUBROUTINE zlaror( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
168 INTEGER info, lda, m, n
172 COMPLEX*16 a( lda, * ), x( * )
178 DOUBLE PRECISION zero, one, toosml
179 parameter( zero = 0.0d+0, one = 1.0d+0,
181 COMPLEX*16 czero, cone
182 parameter( czero = ( 0.0d+0, 0.0d+0 ),
183 $ cone = ( 1.0d+0, 0.0d+0 ) )
186 INTEGER irow, itype, ixfrm,
j, jcol, kbeg, nxfrm
187 DOUBLE PRECISION factor, xabs, xnorm
188 COMPLEX*16 csign, xnorms
200 INTRINSIC abs, dcmplx, dconjg
205 IF( n.EQ.0 .OR. m.EQ.0 )
209 IF(
lsame( side,
'L' ) )
THEN
211 ELSE IF(
lsame( side,
'R' ) )
THEN
213 ELSE IF(
lsame( side,
'C' ) )
THEN
215 ELSE IF(
lsame( side,
'T' ) )
THEN
221 IF( itype.EQ.0 )
THEN
223 ELSE IF( m.LT.0 )
THEN
225 ELSE IF( n.LT.0 .OR. ( itype.EQ.3 .AND. n.NE.m ) )
THEN
227 ELSE IF( lda.LT.m )
THEN
231 CALL
xerbla(
'ZLAROR', -info )
235 IF( itype.EQ.1 )
THEN
243 IF(
lsame( init,
'I' ) )
244 $ CALL
zlaset(
'Full', m, n, czero, cone, a, lda )
257 DO 30 ixfrm = 2, nxfrm
258 kbeg = nxfrm - ixfrm + 1
262 DO 20
j = kbeg, nxfrm
268 xnorm =
dznrm2( ixfrm, x( kbeg ), 1 )
269 xabs = abs( x( kbeg ) )
270 IF( xabs.NE.czero )
THEN
271 csign = x( kbeg ) / xabs
276 x( nxfrm+kbeg ) = -csign
277 factor = xnorm*( xnorm+xabs )
278 IF( abs( factor ).LT.toosml )
THEN
280 CALL
xerbla(
'ZLAROR', -info )
283 factor = one / factor
285 x( kbeg ) = x( kbeg ) + xnorms
289 IF( itype.EQ.1 .OR. itype.EQ.3 .OR. itype.EQ.4 )
THEN
293 CALL
zgemv(
'C', ixfrm, n, cone, a( kbeg, 1 ), lda,
294 $ x( kbeg ), 1, czero, x( 2*nxfrm+1 ), 1 )
295 CALL
zgerc( ixfrm, n, -dcmplx( factor ), x( kbeg ), 1,
296 $ x( 2*nxfrm+1 ), 1, a( kbeg, 1 ), lda )
300 IF( itype.GE.2 .AND. itype.LE.4 )
THEN
304 IF( itype.EQ.4 )
THEN
305 CALL
zlacgv( ixfrm, x( kbeg ), 1 )
308 CALL
zgemv(
'N', m, ixfrm, cone, a( 1, kbeg ), lda,
309 $ x( kbeg ), 1, czero, x( 2*nxfrm+1 ), 1 )
310 CALL
zgerc( m, ixfrm, -dcmplx( factor ), x( 2*nxfrm+1 ), 1,
311 $ x( kbeg ), 1, a( 1, kbeg ), lda )
316 x( 1 ) =
zlarnd( 3, iseed )
318 IF( xabs.NE.zero )
THEN
319 csign = x( 1 ) / xabs
327 IF( itype.EQ.1 .OR. itype.EQ.3 .OR. itype.EQ.4 )
THEN
329 CALL
zscal( n, dconjg( x( nxfrm+irow ) ), a( irow, 1 ),
334 IF( itype.EQ.2 .OR. itype.EQ.3 )
THEN
336 CALL
zscal( m, x( nxfrm+jcol ), a( 1, jcol ), 1 )
340 IF( itype.EQ.4 )
THEN
342 CALL
zscal( m, dconjg( x( nxfrm+jcol ) ), a( 1, jcol ), 1 )
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlaror(SIDE, INIT, M, N, A, LDA, ISEED, X, INFO)
ZLAROR
complex *16 function zlarnd(IDIST, ISEED)
ZLARND
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
logical function lsame(CA, CB)
LSAME
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
double precision function dznrm2(N, X, INCX)
DZNRM2
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL