LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine dlaror ( character  SIDE,
character  INIT,
integer  M,
integer  N,
double precision, dimension( lda, * )  A,
integer  LDA,
integer, dimension( 4 )  ISEED,
double precision, dimension( * )  X,
integer  INFO 
)

DLAROR

Purpose:
 DLAROR 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 DOUBLE PRECISION 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 DLAROR to continue the same random number
          sequence.
[out]X
          X is DOUBLE PRECISION 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 DLARND are bad.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011

Definition at line 148 of file dlaror.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: