|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CUNMTR( SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, 00002 $ WORK, LWORK, INFO ) 00003 * 00004 * -- LAPACK routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER SIDE, TRANS, UPLO 00011 INTEGER INFO, LDA, LDC, LWORK, M, N 00012 * .. 00013 * .. Array Arguments .. 00014 COMPLEX A( LDA, * ), C( LDC, * ), TAU( * ), 00015 $ WORK( * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CUNMTR overwrites the general complex M-by-N matrix C with 00022 * 00023 * SIDE = 'L' SIDE = 'R' 00024 * TRANS = 'N': Q * C C * Q 00025 * TRANS = 'C': Q**H * C C * Q**H 00026 * 00027 * where Q is a complex unitary matrix of order nq, with nq = m if 00028 * SIDE = 'L' and nq = n if SIDE = 'R'. Q is defined as the product of 00029 * nq-1 elementary reflectors, as returned by CHETRD: 00030 * 00031 * if UPLO = 'U', Q = H(nq-1) . . . H(2) H(1); 00032 * 00033 * if UPLO = 'L', Q = H(1) H(2) . . . H(nq-1). 00034 * 00035 * Arguments 00036 * ========= 00037 * 00038 * SIDE (input) CHARACTER*1 00039 * = 'L': apply Q or Q**H from the Left; 00040 * = 'R': apply Q or Q**H from the Right. 00041 * 00042 * UPLO (input) CHARACTER*1 00043 * = 'U': Upper triangle of A contains elementary reflectors 00044 * from CHETRD; 00045 * = 'L': Lower triangle of A contains elementary reflectors 00046 * from CHETRD. 00047 * 00048 * TRANS (input) CHARACTER*1 00049 * = 'N': No transpose, apply Q; 00050 * = 'C': Conjugate transpose, apply Q**H. 00051 * 00052 * M (input) INTEGER 00053 * The number of rows of the matrix C. M >= 0. 00054 * 00055 * N (input) INTEGER 00056 * The number of columns of the matrix C. N >= 0. 00057 * 00058 * A (input) COMPLEX array, dimension 00059 * (LDA,M) if SIDE = 'L' 00060 * (LDA,N) if SIDE = 'R' 00061 * The vectors which define the elementary reflectors, as 00062 * returned by CHETRD. 00063 * 00064 * LDA (input) INTEGER 00065 * The leading dimension of the array A. 00066 * LDA >= max(1,M) if SIDE = 'L'; LDA >= max(1,N) if SIDE = 'R'. 00067 * 00068 * TAU (input) COMPLEX array, dimension 00069 * (M-1) if SIDE = 'L' 00070 * (N-1) if SIDE = 'R' 00071 * TAU(i) must contain the scalar factor of the elementary 00072 * reflector H(i), as returned by CHETRD. 00073 * 00074 * C (input/output) COMPLEX array, dimension (LDC,N) 00075 * On entry, the M-by-N matrix C. 00076 * On exit, C is overwritten by Q*C or Q**H*C or C*Q**H or C*Q. 00077 * 00078 * LDC (input) INTEGER 00079 * The leading dimension of the array C. LDC >= max(1,M). 00080 * 00081 * WORK (workspace/output) COMPLEX array, dimension (MAX(1,LWORK)) 00082 * On exit, if INFO = 0, WORK(1) returns the optimal LWORK. 00083 * 00084 * LWORK (input) INTEGER 00085 * The dimension of the array WORK. 00086 * If SIDE = 'L', LWORK >= max(1,N); 00087 * if SIDE = 'R', LWORK >= max(1,M). 00088 * For optimum performance LWORK >= N*NB if SIDE = 'L', and 00089 * LWORK >=M*NB if SIDE = 'R', where NB is the optimal 00090 * blocksize. 00091 * 00092 * If LWORK = -1, then a workspace query is assumed; the routine 00093 * only calculates the optimal size of the WORK array, returns 00094 * this value as the first entry of the WORK array, and no error 00095 * message related to LWORK is issued by XERBLA. 00096 * 00097 * INFO (output) INTEGER 00098 * = 0: successful exit 00099 * < 0: if INFO = -i, the i-th argument had an illegal value 00100 * 00101 * ===================================================================== 00102 * 00103 * .. Local Scalars .. 00104 LOGICAL LEFT, LQUERY, UPPER 00105 INTEGER I1, I2, IINFO, LWKOPT, MI, NB, NI, NQ, NW 00106 * .. 00107 * .. External Functions .. 00108 LOGICAL LSAME 00109 INTEGER ILAENV 00110 EXTERNAL ILAENV, LSAME 00111 * .. 00112 * .. External Subroutines .. 00113 EXTERNAL CUNMQL, CUNMQR, XERBLA 00114 * .. 00115 * .. Intrinsic Functions .. 00116 INTRINSIC MAX 00117 * .. 00118 * .. Executable Statements .. 00119 * 00120 * Test the input arguments 00121 * 00122 INFO = 0 00123 LEFT = LSAME( SIDE, 'L' ) 00124 UPPER = LSAME( UPLO, 'U' ) 00125 LQUERY = ( LWORK.EQ.-1 ) 00126 * 00127 * NQ is the order of Q and NW is the minimum dimension of WORK 00128 * 00129 IF( LEFT ) THEN 00130 NQ = M 00131 NW = N 00132 ELSE 00133 NQ = N 00134 NW = M 00135 END IF 00136 IF( .NOT.LEFT .AND. .NOT.LSAME( SIDE, 'R' ) ) THEN 00137 INFO = -1 00138 ELSE IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN 00139 INFO = -2 00140 ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) 00141 $ THEN 00142 INFO = -3 00143 ELSE IF( M.LT.0 ) THEN 00144 INFO = -4 00145 ELSE IF( N.LT.0 ) THEN 00146 INFO = -5 00147 ELSE IF( LDA.LT.MAX( 1, NQ ) ) THEN 00148 INFO = -7 00149 ELSE IF( LDC.LT.MAX( 1, M ) ) THEN 00150 INFO = -10 00151 ELSE IF( LWORK.LT.MAX( 1, NW ) .AND. .NOT.LQUERY ) THEN 00152 INFO = -12 00153 END IF 00154 * 00155 IF( INFO.EQ.0 ) THEN 00156 IF( UPPER ) THEN 00157 IF( LEFT ) THEN 00158 NB = ILAENV( 1, 'CUNMQL', SIDE // TRANS, M-1, N, M-1, 00159 $ -1 ) 00160 ELSE 00161 NB = ILAENV( 1, 'CUNMQL', SIDE // TRANS, M, N-1, N-1, 00162 $ -1 ) 00163 END IF 00164 ELSE 00165 IF( LEFT ) THEN 00166 NB = ILAENV( 1, 'CUNMQR', SIDE // TRANS, M-1, N, M-1, 00167 $ -1 ) 00168 ELSE 00169 NB = ILAENV( 1, 'CUNMQR', SIDE // TRANS, M, N-1, N-1, 00170 $ -1 ) 00171 END IF 00172 END IF 00173 LWKOPT = MAX( 1, NW )*NB 00174 WORK( 1 ) = LWKOPT 00175 END IF 00176 * 00177 IF( INFO.NE.0 ) THEN 00178 CALL XERBLA( 'CUNMTR', -INFO ) 00179 RETURN 00180 ELSE IF( LQUERY ) THEN 00181 RETURN 00182 END IF 00183 * 00184 * Quick return if possible 00185 * 00186 IF( M.EQ.0 .OR. N.EQ.0 .OR. NQ.EQ.1 ) THEN 00187 WORK( 1 ) = 1 00188 RETURN 00189 END IF 00190 * 00191 IF( LEFT ) THEN 00192 MI = M - 1 00193 NI = N 00194 ELSE 00195 MI = M 00196 NI = N - 1 00197 END IF 00198 * 00199 IF( UPPER ) THEN 00200 * 00201 * Q was determined by a call to CHETRD with UPLO = 'U' 00202 * 00203 CALL CUNMQL( SIDE, TRANS, MI, NI, NQ-1, A( 1, 2 ), LDA, TAU, C, 00204 $ LDC, WORK, LWORK, IINFO ) 00205 ELSE 00206 * 00207 * Q was determined by a call to CHETRD with UPLO = 'L' 00208 * 00209 IF( LEFT ) THEN 00210 I1 = 2 00211 I2 = 1 00212 ELSE 00213 I1 = 1 00214 I2 = 2 00215 END IF 00216 CALL CUNMQR( SIDE, TRANS, MI, NI, NQ-1, A( 2, 1 ), LDA, TAU, 00217 $ C( I1, I2 ), LDC, WORK, LWORK, IINFO ) 00218 END IF 00219 WORK( 1 ) = LWKOPT 00220 RETURN 00221 * 00222 * End of CUNMTR 00223 * 00224 END
1.7.3 
