LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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 xerbla(srname, info)
Definition cblat2.f:3285
subroutine sgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
SGEMV
Definition sgemv.f:158
subroutine sger(m, n, alpha, x, incx, y, incy, a, lda)
SGER
Definition sger.f:130
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
logical function lsame(ca, cb)
LSAME
Definition lsame.f:48
real(wp) function snrm2(n, x, incx)
SNRM2
Definition snrm2.f90:89
subroutine sscal(n, sa, sx, incx)
SSCAL
Definition sscal.f:79
real function slarnd(idist, iseed)
SLARND
Definition slarnd.f:73
Here is the call graph for this function:
Here is the caller graph for this function: