157 SUBROUTINE zlaror( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
165 INTEGER INFO, LDA, M, N
169 COMPLEX*16 A( LDA, * ), X( * )
175 DOUBLE PRECISION ZERO, ONE, TOOSML
176 parameter( zero = 0.0d+0, one = 1.0d+0,
178 COMPLEX*16 CZERO, CONE
179 parameter( czero = ( 0.0d+0, 0.0d+0 ),
180 $ cone = ( 1.0d+0, 0.0d+0 ) )
183 INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM
184 DOUBLE PRECISION FACTOR, XABS, XNORM
185 COMPLEX*16 CSIGN, XNORMS
189 DOUBLE PRECISION DZNRM2
191 EXTERNAL lsame, dznrm2, zlarnd
197 INTRINSIC abs, dcmplx, dconjg
202 IF( n.EQ.0 .OR. m.EQ.0 )
206 IF( lsame( side,
'L' ) )
THEN
208 ELSE IF( lsame( side,
'R' ) )
THEN
210 ELSE IF( lsame( side,
'C' ) )
THEN
212 ELSE IF( lsame( side,
'T' ) )
THEN
218 IF( itype.EQ.0 )
THEN
220 ELSE IF( m.LT.0 )
THEN
222 ELSE IF( n.LT.0 .OR. ( itype.EQ.3 .AND. n.NE.m ) )
THEN
224 ELSE IF( lda.LT.m )
THEN
228 CALL xerbla(
'ZLAROR', -info )
232 IF( itype.EQ.1 )
THEN
240 IF( lsame( init,
'I' ) )
241 $
CALL zlaset(
'Full', m, n, czero, cone, a, lda )
254 DO 30 ixfrm = 2, nxfrm
255 kbeg = nxfrm - ixfrm + 1
259 DO 20 j = kbeg, nxfrm
260 x( j ) = zlarnd( 3, iseed )
265 xnorm = dznrm2( ixfrm, x( kbeg ), 1 )
266 xabs = abs( x( kbeg ) )
267 IF( xabs.NE.czero )
THEN
268 csign = x( kbeg ) / xabs
273 x( nxfrm+kbeg ) = -csign
274 factor = xnorm*( xnorm+xabs )
275 IF( abs( factor ).LT.toosml )
THEN
277 CALL xerbla(
'ZLAROR', -info )
280 factor = one / factor
282 x( kbeg ) = x( kbeg ) + xnorms
286 IF( itype.EQ.1 .OR. itype.EQ.3 .OR. itype.EQ.4 )
THEN
290 CALL zgemv(
'C', ixfrm, n, cone, a( kbeg, 1 ), lda,
291 $ x( kbeg ), 1, czero, x( 2*nxfrm+1 ), 1 )
292 CALL zgerc( ixfrm, n, -dcmplx( factor ), x( kbeg ), 1,
293 $ x( 2*nxfrm+1 ), 1, a( kbeg, 1 ), lda )
297 IF( itype.GE.2 .AND. itype.LE.4 )
THEN
301 IF( itype.EQ.4 )
THEN
302 CALL zlacgv( ixfrm, x( kbeg ), 1 )
305 CALL zgemv(
'N', m, ixfrm, cone, a( 1, kbeg ), lda,
306 $ x( kbeg ), 1, czero, x( 2*nxfrm+1 ), 1 )
307 CALL zgerc( m, ixfrm, -dcmplx( factor ), x( 2*nxfrm+1 ), 1,
308 $ x( kbeg ), 1, a( 1, kbeg ), lda )
313 x( 1 ) = zlarnd( 3, iseed )
315 IF( xabs.NE.zero )
THEN
316 csign = x( 1 ) / xabs
324 IF( itype.EQ.1 .OR. itype.EQ.3 .OR. itype.EQ.4 )
THEN
326 CALL zscal( n, dconjg( x( nxfrm+irow ) ), a( irow, 1 ),
331 IF( itype.EQ.2 .OR. itype.EQ.3 )
THEN
333 CALL zscal( m, x( nxfrm+jcol ), a( 1, jcol ), 1 )
337 IF( itype.EQ.4 )
THEN
339 CALL zscal( m, dconjg( x( nxfrm+jcol ) ), a( 1, jcol ), 1 )