LAPACK  3.8.0
LAPACK: Linear Algebra PACKage

◆ claror()

subroutine claror ( character  SIDE,
character  INIT,
integer  M,
integer  N,
complex, dimension( lda, * )  A,
integer  LDA,
integer, dimension( 4 )  ISEED,
complex, dimension( * )  X,
integer  INFO 
)

CLAROR

Purpose:
    CLAROR pre- or post-multiplies an M by N matrix A by a random
    unitary 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, pp. 403-409 ).
    (BLAS-2 version)
Parameters
[in]SIDE
          SIDE is CHARACTER*1
           SIDE specifies whether A is multiplied on the left or right
           by U.
       SIDE = 'L'   Multiply A on the left (premultiply) by U
       SIDE = 'R'   Multiply A on the right (postmultiply) by UC>       SIDE = 'C'   Multiply A on the left by U and the right by UC>       SIDE = 'T'   Multiply A on the left by U and the right by U'
           Not modified.
[in]INIT
          INIT is CHARACTER*1
           INIT specifies whether or not A should be initialized to
           the identity matrix.
              INIT = 'I'   Initialize A to (a section of) the
                           identity matrix before applying U.
              INIT = 'N'   No initialization.  Apply U to the
                           input matrix A.

           INIT = 'I' may be used to generate square (i.e., unitary)
           or rectangular orthogonal matrices (orthogonality being
           in the sense of CDOTC):

           For square matrices, M=N, and SIDE many be either 'L' or
           'R'; the rows will be orthogonal to each other, as will the
           columns.
           For rectangular matrices where M < N, SIDE = 'R' will
           produce a dense matrix whose rows will be orthogonal and
           whose columns will not, while SIDE = 'L' will produce a
           matrix whose rows will be orthogonal, and whose first M
           columns will be orthogonal, the remaining columns being
           zero.
           For matrices where M > N, just use the previous
           explanation, interchanging 'L' and 'R' and "rows" and
           "columns".

           Not modified.
[in]M
          M is INTEGER
           Number of rows of A. Not modified.
[in]N
          N is INTEGER
           Number of columns of A. Not modified.
[in,out]A
          A is COMPLEX array, dimension ( LDA, N )
           Input and output array. Overwritten by U A ( if SIDE = 'L' )
           or by A U ( if SIDE = 'R' )
           or by U A U* ( if SIDE = 'C')
           or by U A U' ( if SIDE = 'T') on exit.
[in]LDA
          LDA is INTEGER
           Leading dimension of A. Must be at least MAX ( 1, M ).
           Not modified.
[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 CLAROR to continue the same random number
           sequence.
           Modified.
[out]X
          X is COMPLEX 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'.
           Modified.
[out]INFO
          INFO is INTEGER
           An error flag.  It is set to:
            0  if no error.
            1  if CLARND returned a bad random number (installation
               problem)
           -1  if SIDE is not L, R, C, or T.
           -3  if M is negative.
           -4  if N is negative or if SIDE is C or T and N is not equal
               to M.
           -6  if LDA is less than M.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
December 2016

Definition at line 160 of file claror.f.

160 *
161 * -- LAPACK auxiliary routine (version 3.7.0) --
162 * -- LAPACK is a software package provided by Univ. of Tennessee, --
163 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
164 * December 2016
165 *
166 * .. Scalar Arguments ..
167  CHARACTER init, side
168  INTEGER info, lda, m, n
169 * ..
170 * .. Array Arguments ..
171  INTEGER iseed( 4 )
172  COMPLEX a( lda, * ), x( * )
173 * ..
174 *
175 * =====================================================================
176 *
177 * .. Parameters ..
178  REAL zero, one, toosml
179  parameter( zero = 0.0e+0, one = 1.0e+0,
180  $ toosml = 1.0e-20 )
181  COMPLEX czero, cone
182  parameter( czero = ( 0.0e+0, 0.0e+0 ),
183  $ cone = ( 1.0e+0, 0.0e+0 ) )
184 * ..
185 * .. Local Scalars ..
186  INTEGER irow, itype, ixfrm, j, jcol, kbeg, nxfrm
187  REAL factor, xabs, xnorm
188  COMPLEX csign, xnorms
189 * ..
190 * .. External Functions ..
191  LOGICAL lsame
192  REAL scnrm2
193  COMPLEX clarnd
194  EXTERNAL lsame, scnrm2, clarnd
195 * ..
196 * .. External Subroutines ..
197  EXTERNAL cgemv, cgerc, clacgv, claset, cscal, xerbla
198 * ..
199 * .. Intrinsic Functions ..
200  INTRINSIC abs, cmplx, conjg
201 * ..
202 * .. Executable Statements ..
203 *
204  info = 0
205  IF( n.EQ.0 .OR. m.EQ.0 )
206  $ RETURN
207 *
208  itype = 0
209  IF( lsame( side, 'L' ) ) THEN
210  itype = 1
211  ELSE IF( lsame( side, 'R' ) ) THEN
212  itype = 2
213  ELSE IF( lsame( side, 'C' ) ) THEN
214  itype = 3
215  ELSE IF( lsame( side, 'T' ) ) THEN
216  itype = 4
217  END IF
218 *
219 * Check for argument errors.
220 *
221  IF( itype.EQ.0 ) THEN
222  info = -1
223  ELSE IF( m.LT.0 ) THEN
224  info = -3
225  ELSE IF( n.LT.0 .OR. ( itype.EQ.3 .AND. n.NE.m ) ) THEN
226  info = -4
227  ELSE IF( lda.LT.m ) THEN
228  info = -6
229  END IF
230  IF( info.NE.0 ) THEN
231  CALL xerbla( 'CLAROR', -info )
232  RETURN
233  END IF
234 *
235  IF( itype.EQ.1 ) THEN
236  nxfrm = m
237  ELSE
238  nxfrm = n
239  END IF
240 *
241 * Initialize A to the identity matrix if desired
242 *
243  IF( lsame( init, 'I' ) )
244  $ CALL claset( 'Full', m, n, czero, cone, a, lda )
245 *
246 * If no rotation possible, still multiply by
247 * a random complex number from the circle |x| = 1
248 *
249 * 2) Compute Rotation by computing Householder
250 * Transformations H(2), H(3), ..., H(n). Note that the
251 * order in which they are computed is irrelevant.
252 *
253  DO 40 j = 1, nxfrm
254  x( j ) = czero
255  40 CONTINUE
256 *
257  DO 60 ixfrm = 2, nxfrm
258  kbeg = nxfrm - ixfrm + 1
259 *
260 * Generate independent normal( 0, 1 ) random numbers
261 *
262  DO 50 j = kbeg, nxfrm
263  x( j ) = clarnd( 3, iseed )
264  50 CONTINUE
265 *
266 * Generate a Householder transformation from the random vector X
267 *
268  xnorm = scnrm2( ixfrm, x( kbeg ), 1 )
269  xabs = abs( x( kbeg ) )
270  IF( xabs.NE.czero ) THEN
271  csign = x( kbeg ) / xabs
272  ELSE
273  csign = cone
274  END IF
275  xnorms = csign*xnorm
276  x( nxfrm+kbeg ) = -csign
277  factor = xnorm*( xnorm+xabs )
278  IF( abs( factor ).LT.toosml ) THEN
279  info = 1
280  CALL xerbla( 'CLAROR', -info )
281  RETURN
282  ELSE
283  factor = one / factor
284  END IF
285  x( kbeg ) = x( kbeg ) + xnorms
286 *
287 * Apply Householder transformation to A
288 *
289  IF( itype.EQ.1 .OR. itype.EQ.3 .OR. itype.EQ.4 ) THEN
290 *
291 * Apply H(k) on the left of A
292 *
293  CALL cgemv( 'C', ixfrm, n, cone, a( kbeg, 1 ), lda,
294  $ x( kbeg ), 1, czero, x( 2*nxfrm+1 ), 1 )
295  CALL cgerc( ixfrm, n, -cmplx( factor ), x( kbeg ), 1,
296  $ x( 2*nxfrm+1 ), 1, a( kbeg, 1 ), lda )
297 *
298  END IF
299 *
300  IF( itype.GE.2 .AND. itype.LE.4 ) THEN
301 *
302 * Apply H(k)* (or H(k)') on the right of A
303 *
304  IF( itype.EQ.4 ) THEN
305  CALL clacgv( ixfrm, x( kbeg ), 1 )
306  END IF
307 *
308  CALL cgemv( 'N', m, ixfrm, cone, a( 1, kbeg ), lda,
309  $ x( kbeg ), 1, czero, x( 2*nxfrm+1 ), 1 )
310  CALL cgerc( m, ixfrm, -cmplx( factor ), x( 2*nxfrm+1 ), 1,
311  $ x( kbeg ), 1, a( 1, kbeg ), lda )
312 *
313  END IF
314  60 CONTINUE
315 *
316  x( 1 ) = clarnd( 3, iseed )
317  xabs = abs( x( 1 ) )
318  IF( xabs.NE.zero ) THEN
319  csign = x( 1 ) / xabs
320  ELSE
321  csign = cone
322  END IF
323  x( 2*nxfrm ) = csign
324 *
325 * Scale the matrix A by D.
326 *
327  IF( itype.EQ.1 .OR. itype.EQ.3 .OR. itype.EQ.4 ) THEN
328  DO 70 irow = 1, m
329  CALL cscal( n, conjg( x( nxfrm+irow ) ), a( irow, 1 ), lda )
330  70 CONTINUE
331  END IF
332 *
333  IF( itype.EQ.2 .OR. itype.EQ.3 ) THEN
334  DO 80 jcol = 1, n
335  CALL cscal( m, x( nxfrm+jcol ), a( 1, jcol ), 1 )
336  80 CONTINUE
337  END IF
338 *
339  IF( itype.EQ.4 ) THEN
340  DO 90 jcol = 1, n
341  CALL cscal( m, conjg( x( nxfrm+jcol ) ), a( 1, jcol ), 1 )
342  90 CONTINUE
343  END IF
344  RETURN
345 *
346 * End of CLAROR
347 *
real function scnrm2(N, X, INCX)
SCNRM2
Definition: scnrm2.f:77
complex function clarnd(IDIST, ISEED)
CLARND
Definition: clarnd.f:77
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
subroutine cscal(N, CA, CX, INCX)
CSCAL
Definition: cscal.f:80
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:160
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERC
Definition: cgerc.f:132
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:55
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
Definition: clacgv.f:76
Here is the call graph for this function:
Here is the caller graph for this function: