LAPACK  3.9.1
LAPACK: Linear Algebra PACKage

◆ 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.

146 *
147 * -- LAPACK auxiliary routine --
148 * -- LAPACK is a software package provided by Univ. of Tennessee, --
149 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
150 *
151 * .. Scalar Arguments ..
152  CHARACTER INIT, SIDE
153  INTEGER INFO, LDA, M, N
154 * ..
155 * .. Array Arguments ..
156  INTEGER ISEED( 4 )
157  REAL A( LDA, * ), X( * )
158 * ..
159 *
160 * =====================================================================
161 *
162 * .. Parameters ..
163  REAL ZERO, ONE, TOOSML
164  parameter( zero = 0.0e+0, one = 1.0e+0,
165  $ toosml = 1.0e-20 )
166 * ..
167 * .. Local Scalars ..
168  INTEGER IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM
169  REAL FACTOR, XNORM, XNORMS
170 * ..
171 * .. External Functions ..
172  LOGICAL LSAME
173  REAL SLARND, SNRM2
174  EXTERNAL lsame, slarnd, snrm2
175 * ..
176 * .. External Subroutines ..
177  EXTERNAL sgemv, sger, slaset, sscal, xerbla
178 * ..
179 * .. Intrinsic Functions ..
180  INTRINSIC abs, sign
181 * ..
182 * .. Executable Statements ..
183 *
184  info = 0
185  IF( n.EQ.0 .OR. m.EQ.0 )
186  $ RETURN
187 *
188  itype = 0
189  IF( lsame( side, 'L' ) ) THEN
190  itype = 1
191  ELSE IF( lsame( side, 'R' ) ) THEN
192  itype = 2
193  ELSE IF( lsame( side, 'C' ) .OR. lsame( side, 'T' ) ) THEN
194  itype = 3
195  END IF
196 *
197 * Check for argument errors.
198 *
199  IF( itype.EQ.0 ) THEN
200  info = -1
201  ELSE IF( m.LT.0 ) THEN
202  info = -3
203  ELSE IF( n.LT.0 .OR. ( itype.EQ.3 .AND. n.NE.m ) ) THEN
204  info = -4
205  ELSE IF( lda.LT.m ) THEN
206  info = -6
207  END IF
208  IF( info.NE.0 ) THEN
209  CALL xerbla( 'SLAROR', -info )
210  RETURN
211  END IF
212 *
213  IF( itype.EQ.1 ) THEN
214  nxfrm = m
215  ELSE
216  nxfrm = n
217  END IF
218 *
219 * Initialize A to the identity matrix if desired
220 *
221  IF( lsame( init, 'I' ) )
222  $ CALL slaset( 'Full', m, n, zero, one, a, lda )
223 *
224 * If no rotation possible, multiply by random +/-1
225 *
226 * Compute rotation by computing Householder transformations
227 * H(2), H(3), ..., H(nhouse)
228 *
229  DO 10 j = 1, nxfrm
230  x( j ) = zero
231  10 CONTINUE
232 *
233  DO 30 ixfrm = 2, nxfrm
234  kbeg = nxfrm - ixfrm + 1
235 *
236 * Generate independent normal( 0, 1 ) random numbers
237 *
238  DO 20 j = kbeg, nxfrm
239  x( j ) = slarnd( 3, iseed )
240  20 CONTINUE
241 *
242 * Generate a Householder transformation from the random vector X
243 *
244  xnorm = snrm2( ixfrm, x( kbeg ), 1 )
245  xnorms = sign( xnorm, x( kbeg ) )
246  x( kbeg+nxfrm ) = sign( one, -x( kbeg ) )
247  factor = xnorms*( xnorms+x( kbeg ) )
248  IF( abs( factor ).LT.toosml ) THEN
249  info = 1
250  CALL xerbla( 'SLAROR', info )
251  RETURN
252  ELSE
253  factor = one / factor
254  END IF
255  x( kbeg ) = x( kbeg ) + xnorms
256 *
257 * Apply Householder transformation to A
258 *
259  IF( itype.EQ.1 .OR. itype.EQ.3 ) THEN
260 *
261 * Apply H(k) from the left.
262 *
263  CALL sgemv( 'T', ixfrm, n, one, a( kbeg, 1 ), lda,
264  $ x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
265  CALL sger( ixfrm, n, -factor, x( kbeg ), 1, x( 2*nxfrm+1 ),
266  $ 1, a( kbeg, 1 ), lda )
267 *
268  END IF
269 *
270  IF( itype.EQ.2 .OR. itype.EQ.3 ) THEN
271 *
272 * Apply H(k) from the right.
273 *
274  CALL sgemv( 'N', m, ixfrm, one, a( 1, kbeg ), lda,
275  $ x( kbeg ), 1, zero, x( 2*nxfrm+1 ), 1 )
276  CALL sger( m, ixfrm, -factor, x( 2*nxfrm+1 ), 1, x( kbeg ),
277  $ 1, a( 1, kbeg ), lda )
278 *
279  END IF
280  30 CONTINUE
281 *
282  x( 2*nxfrm ) = sign( one, slarnd( 3, iseed ) )
283 *
284 * Scale the matrix A by D.
285 *
286  IF( itype.EQ.1 .OR. itype.EQ.3 ) THEN
287  DO 40 irow = 1, m
288  CALL sscal( n, x( nxfrm+irow ), a( irow, 1 ), lda )
289  40 CONTINUE
290  END IF
291 *
292  IF( itype.EQ.2 .OR. itype.EQ.3 ) THEN
293  DO 50 jcol = 1, n
294  CALL sscal( m, x( nxfrm+jcol ), a( 1, jcol ), 1 )
295  50 CONTINUE
296  END IF
297  RETURN
298 *
299 * End of SLAROR
300 *
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.
Definition: slaset.f:110
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
real function slarnd(IDIST, ISEED)
SLARND
Definition: slarnd.f:73
subroutine sscal(N, SA, SX, INCX)
SSCAL
Definition: sscal.f:79
real function snrm2(N, X, INCX)
SNRM2
Definition: snrm2.f:74
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
Definition: sger.f:130
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
Definition: sgemv.f:156
Here is the call graph for this function:
Here is the caller graph for this function: