slaror()

subroutine slaror	(	character	side,
		character	init,
		integer	m,
		integer	n,
		real, dimension( lda, * )	a,
		integer	lda,
		integer, dimension( 4 )	iseed,
		real, dimension( * )	x,
		integer	info )

SLAROR

Purpose:

!>
!> SLAROR pre- or post-multiplies an M by N matrix A by a random
!> orthogonal matrix U, overwriting A.  A may optionally be initialized
!> to the identity matrix before multiplying by U.  U is generated using
!> the method of G.W. Stewart (SIAM J. Numer. Anal. 17, 1980, 403-409).
!> 

Parameters

[in]	SIDE	!> SIDE is CHARACTER*1 !> Specifies whether A is multiplied on the left or right by U. !> = 'L': Multiply A on the left (premultiply) by U !> = 'R': Multiply A on the right (postmultiply) by U' !> = 'C' or 'T': Multiply A on the left by U and the right !> by U' (Here, U' means U-transpose.) !>
[in]	INIT	!> INIT is CHARACTER*1 !> Specifies whether or not A should be initialized to the !> identity matrix. !> = 'I': Initialize A to (a section of) the identity matrix !> before applying U. !> = 'N': No initialization. Apply U to the input matrix A. !> !> INIT = 'I' may be used to generate square or rectangular !> orthogonal matrices: !> !> For M = N and SIDE = 'L' or 'R', the rows will be orthogonal !> to each other, as will the columns. !> !> If M < N, SIDE = 'R' produces a dense matrix whose rows are !> orthogonal and whose columns are not, while SIDE = 'L' !> produces a matrix whose rows are orthogonal, and whose first !> M columns are orthogonal, and whose remaining columns are !> zero. !> !> If M > N, SIDE = 'L' produces a dense matrix whose columns !> are orthogonal and whose rows are not, while SIDE = 'R' !> produces a matrix whose columns are orthogonal, and whose !> first M rows are orthogonal, and whose remaining rows are !> zero. !>
[in]	M	!> M is INTEGER !> The number of rows of A. !>
[in]	N	!> N is INTEGER !> The number of columns of A. !>
[in,out]	A	!> A is REAL array, dimension (LDA, N) !> On entry, the array A. !> On exit, overwritten by U A ( if SIDE = 'L' ), !> or by A U ( if SIDE = 'R' ), !> or by U A U' ( if SIDE = 'C' or 'T'). !>
[in]	LDA	!> LDA is INTEGER !> The leading dimension of the array A. LDA >= max(1,M). !>
[in,out]	ISEED	!> ISEED is INTEGER array, dimension (4) !> On entry ISEED specifies the seed of the random number !> generator. The array elements should be between 0 and 4095; !> if not they will be reduced mod 4096. Also, ISEED(4) must !> be odd. The random number generator uses a linear !> congruential sequence limited to small integers, and so !> should produce machine independent random numbers. The !> values of ISEED are changed on exit, and can be used in the !> next call to SLAROR to continue the same random number !> sequence. !>
[out]	X	!> X is REAL array, dimension (3*MAX( M, N )) !> Workspace of length !> 2*M + N if SIDE = 'L', !> 2*N + M if SIDE = 'R', !> 3*N if SIDE = 'C' or 'T'. !>
[out]	INFO	!> INFO is INTEGER !> An error flag. It is set to: !> = 0: normal return !> < 0: if INFO = -k, the k-th argument had an illegal value !> = 1: if the random numbers generated by SLARND are bad. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 145 of file slaror.f.

*
*  -- LAPACK auxiliary routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      CHARACTER          INIT, SIDE
      INTEGER            INFO, LDA, M, N
*     ..
*     .. Array Arguments ..
      INTEGER            ISEED( 4 )
      REAL               A( LDA, * ), X( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ZERO, ONE, TOOSML
      parameter( zero = 0.0e+0, one = 1.0e+0,
     $                   toosml = 1.0e-20 )
*     ..
*     .. Local Scalars ..
      INTEGER            IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM
      REAL               FACTOR, XNORM, XNORMS
*     ..
*     .. External Functions ..
      LOGICAL            LSAME
      REAL               SLARND, SNRM2
      EXTERNAL           lsame, slarnd, snrm2
*     ..
*     .. External Subroutines ..
      EXTERNAL           sgemv, sger, slaset, sscal, xerbla
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, sign
*     ..
*     .. Executable Statements ..
*
      info = 0
      IF( n.EQ.0 .OR. m.EQ.0 )
     $   RETURN
*
      itype = 0
      IF( lsame( side, 'L' ) ) THEN
         itype = 1
      ELSE IF( lsame( side, 'R' ) ) THEN
         itype = 2
      ELSE IF( lsame( side, 'C' ) .OR. lsame( side, 'T' ) ) THEN
         itype = 3
      END IF
*
*     Check for argument errors.
*
      IF( itype.EQ.0 ) THEN
         info = -1
      ELSE IF( m.LT.0 ) THEN
         info = -3
      ELSE IF( n.LT.0 .OR. ( itype.EQ.3 .AND. n.NE.m ) ) THEN
         info = -4
      ELSE IF( lda.LT.m ) THEN
         info = -6
      END IF
      IF( info.NE.0 ) THEN
         CALL xerbla( 'SLAROR', -info )
         RETURN
      END IF
*
      IF( itype.EQ.1 ) THEN
         nxfrm = m
      ELSE
         nxfrm = n
      END IF
*
*     Initialize A to the identity matrix if desired
*
      IF( lsame( init, 'I' ) )
     $   CALL slaset( 'Full', m, n, zero, one, a, lda )
*
*     If no rotation possible, multiply by random +/-1
*
*     Compute rotation by computing Householder transformations
*     H(2), H(3), ..., H(nhouse)
*
      DO 10 j = 1, nxfrm
         x( j ) = zero
   10 CONTINUE
*
      DO 30 ixfrm = 2, nxfrm
         kbeg = nxfrm - ixfrm + 1
*
*        Generate independent normal( 0, 1 ) random numbers
*
         DO 20 j = kbeg, nxfrm
            x( j ) = slarnd( 3, iseed )
   20    CONTINUE
*
*        Generate a Householder transformation from the random vector X
*
         xnorm = snrm2( ixfrm, x( kbeg ), 1 )
         xnorms = sign( xnorm, x( kbeg ) )
         x( kbeg+nxfrm ) = sign( one, -x( kbeg ) )
         factor = xnorms*( xnorms+x( kbeg ) )
         IF( abs( factor ).LT.toosml ) THEN
            info = 1
            CALL xerbla( 'SLAROR', info )
            RETURN
         ELSE
            factor = one / factor
         END IF
         x( kbeg ) = x( kbeg ) + xnorms
*
*        Apply Householder transformation to A
*
         IF( itype.EQ.1 .OR. itype.EQ.3 ) THEN
*
*           Apply H(k) from the left.
*
            CALL sgemv( 'T', ixfrm, n, one, a( kbeg, 1 ), lda,
     $                  x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
            CALL sger( ixfrm, n, -factor, x( kbeg ), 1, x( 2*nxfrm+1 ),
     $                 1, a( kbeg, 1 ), lda )
*
         END IF
*
         IF( itype.EQ.2 .OR. itype.EQ.3 ) THEN
*
*           Apply H(k) from the right.
*
            CALL sgemv( 'N', m, ixfrm, one, a( 1, kbeg ), lda,
     $                  x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
            CALL sger( m, ixfrm, -factor, x( 2*nxfrm+1 ), 1, x( kbeg ),
     $                 1, a( 1, kbeg ), lda )
*
         END IF
   30 CONTINUE
*
      x( 2*nxfrm ) = sign( one, slarnd( 3, iseed ) )
*
*     Scale the matrix A by D.
*
      IF( itype.EQ.1 .OR. itype.EQ.3 ) THEN
         DO 40 irow = 1, m
            CALL sscal( n, x( nxfrm+irow ), a( irow, 1 ), lda )
   40    CONTINUE
      END IF
*
      IF( itype.EQ.2 .OR. itype.EQ.3 ) THEN
         DO 50 jcol = 1, n
            CALL sscal( m, x( nxfrm+jcol ), a( 1, jcol ), 1 )
   50    CONTINUE
      END IF
      RETURN
*
*     End of SLAROR
*

Here is the call graph for this function:

Here is the caller graph for this function: