LAPACK: TESTING/MATGEN/claror.f Source File

Go to the documentation of this file.
00001       SUBROUTINE CLAROR( SIDE, INIT, M, N, A, LDA, ISEED, X, INFO )
00002 *
00003 *  -- LAPACK auxiliary test routine (version 3.1) --
00004 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00005 *     June 2010
00006 *
00007 *     .. Scalar Arguments ..
00008       CHARACTER          INIT, SIDE
00009       INTEGER            INFO, LDA, M, N
00010 *     ..
00011 *     .. Array Arguments ..
00012       INTEGER            ISEED( 4 )
00013       COMPLEX            A( LDA, * ), X( * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *     CLAROR pre- or post-multiplies an M by N matrix A by a random
00020 *     unitary matrix U, overwriting A. A may optionally be
00021 *     initialized to the identity matrix before multiplying by U.
00022 *     U is generated using the method of G.W. Stewart
00023 *     ( SIAM J. Numer. Anal. 17, 1980, pp. 403-409 ).
00024 *     (BLAS-2 version)
00025 *
00026 *  Arguments
00027 *  =========
00028 *
00029 *  SIDE     (input) CHARACTER*1
00030 *           SIDE specifies whether A is multiplied on the left or right
00031 *           by U.
00032 *       SIDE = 'L'   Multiply A on the left (premultiply) by U
00033 *       SIDE = 'R'   Multiply A on the right (postmultiply) by U*
00034 *       SIDE = 'C'   Multiply A on the left by U and the right by U*
00035 *       SIDE = 'T'   Multiply A on the left by U and the right by U'
00036 *           Not modified.
00037 *
00038 *  INIT     (input) CHARACTER*1
00039 *           INIT specifies whether or not A should be initialized to
00040 *           the identity matrix.
00041 *              INIT = 'I'   Initialize A to (a section of) the
00042 *                           identity matrix before applying U.
00043 *              INIT = 'N'   No initialization.  Apply U to the
00044 *                           input matrix A.
00045 *
00046 *           INIT = 'I' may be used to generate square (i.e., unitary)
00047 *           or rectangular orthogonal matrices (orthogonality being
00048 *           in the sense of CDOTC):
00049 *
00050 *           For square matrices, M=N, and SIDE many be either 'L' or
00051 *           'R'; the rows will be orthogonal to each other, as will the
00052 *           columns.
00053 *           For rectangular matrices where M < N, SIDE = 'R' will
00054 *           produce a dense matrix whose rows will be orthogonal and
00055 *           whose columns will not, while SIDE = 'L' will produce a
00056 *           matrix whose rows will be orthogonal, and whose first M
00057 *           columns will be orthogonal, the remaining columns being
00058 *           zero.
00059 *           For matrices where M > N, just use the previous
00060 *           explaination, interchanging 'L' and 'R' and "rows" and
00061 *           "columns".
00062 *
00063 *           Not modified.
00064 *
00065 *  M        (input) INTEGER
00066 *           Number of rows of A. Not modified.
00067 *
00068 *  N        (input) INTEGER
00069 *           Number of columns of A. Not modified.
00070 *
00071 *  A        (input/output) COMPLEX array, dimension ( LDA, N )
00072 *           Input and output array. Overwritten by U A ( if SIDE = 'L' )
00073 *           or by A U ( if SIDE = 'R' )
00074 *           or by U A U* ( if SIDE = 'C')
00075 *           or by U A U' ( if SIDE = 'T') on exit.
00076 *
00077 *  LDA       (input) INTEGER
00078 *           Leading dimension of A. Must be at least MAX ( 1, M ).
00079 *           Not modified.
00080 *
00081 *  ISEED    (input/output) INTEGER array, dimension ( 4 )
00082 *           On entry ISEED specifies the seed of the random number
00083 *           generator. The array elements should be between 0 and 4095;
00084 *           if not they will be reduced mod 4096.  Also, ISEED(4) must
00085 *           be odd.  The random number generator uses a linear
00086 *           congruential sequence limited to small integers, and so
00087 *           should produce machine independent random numbers. The
00088 *           values of ISEED are changed on exit, and can be used in the
00089 *           next call to CLAROR to continue the same random number
00090 *           sequence.
00091 *           Modified.
00092 *
00093 *  X        (workspace) COMPLEX array, dimension ( 3*MAX( M, N ) )
00094 *           Workspace. Of length:
00095 *               2*M + N if SIDE = 'L',
00096 *               2*N + M if SIDE = 'R',
00097 *               3*N     if SIDE = 'C' or 'T'.
00098 *           Modified.
00099 *
00100 *  INFO     (output) INTEGER
00101 *           An error flag.  It is set to:
00102 *            0  if no error.
00103 *            1  if CLARND returned a bad random number (installation
00104 *               problem)
00105 *           -1  if SIDE is not L, R, C, or T.
00106 *           -3  if M is negative.
00107 *           -4  if N is negative or if SIDE is C or T and N is not equal
00108 *               to M.
00109 *           -6  if LDA is less than M.
00110 *
00111 *  =====================================================================
00112 *
00113 *     .. Parameters ..
00114       REAL               ZERO, ONE, TOOSML
00115       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0,
00116      $                   TOOSML = 1.0E-20 )
00117       COMPLEX            CZERO, CONE
00118       PARAMETER          ( CZERO = ( 0.0E+0, 0.0E+0 ),
00119      $                   CONE = ( 1.0E+0, 0.0E+0 ) )
00120 *     ..
00121 *     .. Local Scalars ..
00122       INTEGER            IROW, ITYPE, IXFRM, J, JCOL, KBEG, NXFRM
00123       REAL               FACTOR, XABS, XNORM
00124       COMPLEX            CSIGN, XNORMS
00125 *     ..
00126 *     .. External Functions ..
00127       LOGICAL            LSAME
00128       REAL               SCNRM2
00129       COMPLEX            CLARND
00130       EXTERNAL           LSAME, SCNRM2, CLARND
00131 *     ..
00132 *     .. External Subroutines ..
00133       EXTERNAL           CGEMV, CGERC, CLACGV, CLASET, CSCAL, XERBLA
00134 *     ..
00135 *     .. Intrinsic Functions ..
00136       INTRINSIC          ABS, CMPLX, CONJG
00137 *     ..
00138 *     .. Executable Statements ..
00139 *
00140       IF( N.EQ.0 .OR. M.EQ.0 )
00141      $   RETURN
00142 *
00143       ITYPE = 0
00144       IF( LSAME( SIDE, 'L' ) ) THEN
00145          ITYPE = 1
00146       ELSE IF( LSAME( SIDE, 'R' ) ) THEN
00147          ITYPE = 2
00148       ELSE IF( LSAME( SIDE, 'C' ) ) THEN
00149          ITYPE = 3
00150       ELSE IF( LSAME( SIDE, 'T' ) ) THEN
00151          ITYPE = 4
00152       END IF
00153 *
00154 *     Check for argument errors.
00155 *
00156       INFO = 0
00157       IF( ITYPE.EQ.0 ) THEN
00158          INFO = -1
00159       ELSE IF( M.LT.0 ) THEN
00160          INFO = -3
00161       ELSE IF( N.LT.0 .OR. ( ITYPE.EQ.3 .AND. N.NE.M ) ) THEN
00162          INFO = -4
00163       ELSE IF( LDA.LT.M ) THEN
00164          INFO = -6
00165       END IF
00166       IF( INFO.NE.0 ) THEN
00167          CALL XERBLA( 'CLAROR', -INFO )
00168          RETURN
00169       END IF
00170 *
00171       IF( ITYPE.EQ.1 ) THEN
00172          NXFRM = M
00173       ELSE
00174          NXFRM = N
00175       END IF
00176 *
00177 *     Initialize A to the identity matrix if desired
00178 *
00179       IF( LSAME( INIT, 'I' ) )
00180      $   CALL CLASET( 'Full', M, N, CZERO, CONE, A, LDA )
00181 *
00182 *     If no rotation possible, still multiply by
00183 *     a random complex number from the circle |x| = 1
00184 *
00185 *      2)      Compute Rotation by computing Householder
00186 *              Transformations H(2), H(3), ..., H(n).  Note that the
00187 *              order in which they are computed is irrelevant.
00188 *
00189       DO 40 J = 1, NXFRM
00190          X( J ) = CZERO
00191    40 CONTINUE
00192 *
00193       DO 60 IXFRM = 2, NXFRM
00194          KBEG = NXFRM - IXFRM + 1
00195 *
00196 *        Generate independent normal( 0, 1 ) random numbers
00197 *
00198          DO 50 J = KBEG, NXFRM
00199             X( J ) = CLARND( 3, ISEED )
00200    50    CONTINUE
00201 *
00202 *        Generate a Householder transformation from the random vector X
00203 *
00204          XNORM = SCNRM2( IXFRM, X( KBEG ), 1 )
00205          XABS = ABS( X( KBEG ) )
00206          IF( XABS.NE.CZERO ) THEN
00207             CSIGN = X( KBEG ) / XABS
00208          ELSE
00209             CSIGN = CONE
00210          END IF
00211          XNORMS = CSIGN*XNORM
00212          X( NXFRM+KBEG ) = -CSIGN
00213          FACTOR = XNORM*( XNORM+XABS )
00214          IF( ABS( FACTOR ).LT.TOOSML ) THEN
00215             INFO = 1
00216             CALL XERBLA( 'CLAROR', -INFO )
00217             RETURN
00218          ELSE
00219             FACTOR = ONE / FACTOR
00220          END IF
00221          X( KBEG ) = X( KBEG ) + XNORMS
00222 *
00223 *        Apply Householder transformation to A
00224 *
00225          IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 .OR. ITYPE.EQ.4 ) THEN
00226 *
00227 *           Apply H(k) on the left of A
00228 *
00229             CALL CGEMV( 'C', IXFRM, N, CONE, A( KBEG, 1 ), LDA,
00230      $                  X( KBEG ), 1, CZERO, X( 2*NXFRM+1 ), 1 )
00231             CALL CGERC( IXFRM, N, -CMPLX( FACTOR ), X( KBEG ), 1,
00232      $                  X( 2*NXFRM+1 ), 1, A( KBEG, 1 ), LDA )
00233 *
00234          END IF
00235 *
00236          IF( ITYPE.GE.2 .AND. ITYPE.LE.4 ) THEN
00237 *
00238 *           Apply H(k)* (or H(k)') on the right of A
00239 *
00240             IF( ITYPE.EQ.4 ) THEN
00241                CALL CLACGV( IXFRM, X( KBEG ), 1 )
00242             END IF
00243 *
00244             CALL CGEMV( 'N', M, IXFRM, CONE, A( 1, KBEG ), LDA,
00245      $                  X( KBEG ), 1, CZERO, X( 2*NXFRM+1 ), 1 )
00246             CALL CGERC( M, IXFRM, -CMPLX( FACTOR ), X( 2*NXFRM+1 ), 1,
00247      $                  X( KBEG ), 1, A( 1, KBEG ), LDA )
00248 *
00249          END IF
00250    60 CONTINUE
00251 *
00252       X( 1 ) = CLARND( 3, ISEED )
00253       XABS = ABS( X( 1 ) )
00254       IF( XABS.NE.ZERO ) THEN
00255          CSIGN = X( 1 ) / XABS
00256       ELSE
00257          CSIGN = CONE
00258       END IF
00259       X( 2*NXFRM ) = CSIGN
00260 *
00261 *     Scale the matrix A by D.
00262 *
00263       IF( ITYPE.EQ.1 .OR. ITYPE.EQ.3 .OR. ITYPE.EQ.4 ) THEN
00264          DO 70 IROW = 1, M
00265             CALL CSCAL( N, CONJG( X( NXFRM+IROW ) ), A( IROW, 1 ), LDA )
00266    70    CONTINUE
00267       END IF
00268 *
00269       IF( ITYPE.EQ.2 .OR. ITYPE.EQ.3 ) THEN
00270          DO 80 JCOL = 1, N
00271             CALL CSCAL( M, X( NXFRM+JCOL ), A( 1, JCOL ), 1 )
00272    80    CONTINUE
00273       END IF
00274 *
00275       IF( ITYPE.EQ.4 ) THEN
00276          DO 90 JCOL = 1, N
00277             CALL CSCAL( M, CONJG( X( NXFRM+JCOL ) ), A( 1, JCOL ), 1 )
00278    90    CONTINUE
00279       END IF
00280       RETURN
00281 *
00282 *     End of CLAROR
00283 *
00284       END