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
192 DOUBLE PRECISION DZNRM2
194 EXTERNAL lsame, dznrm2, zlarnd
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
263 x( j ) = zlarnd( 3, iseed )
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 zlaror(SIDE, INIT, M, N, A, LDA, ISEED, X, INFO)
ZLAROR
subroutine zgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERC
subroutine xerbla(SRNAME, INFO)
XERBLA
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...
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL