![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLARHS 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 * Definition: 00009 * =========== 00010 * 00011 * SUBROUTINE CLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, 00012 * A, LDA, X, LDX, B, LDB, ISEED, INFO ) 00013 * 00014 * .. Scalar Arguments .. 00015 * CHARACTER TRANS, UPLO, XTYPE 00016 * CHARACTER*3 PATH 00017 * INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS 00018 * .. 00019 * .. Array Arguments .. 00020 * INTEGER ISEED( 4 ) 00021 * COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> CLARHS chooses a set of NRHS random solution vectors and sets 00031 *> up the right hand sides for the linear system 00032 *> op( A ) * X = B, 00033 *> where op( A ) may be A, A**T (transpose of A), or A**H (conjugate 00034 *> transpose of A). 00035 *> \endverbatim 00036 * 00037 * Arguments: 00038 * ========== 00039 * 00040 *> \param[in] PATH 00041 *> \verbatim 00042 *> PATH is CHARACTER*3 00043 *> The type of the complex matrix A. PATH may be given in any 00044 *> combination of upper and lower case. Valid paths include 00045 *> xGE: General m x n matrix 00046 *> xGB: General banded matrix 00047 *> xPO: Hermitian positive definite, 2-D storage 00048 *> xPP: Hermitian positive definite packed 00049 *> xPB: Hermitian positive definite banded 00050 *> xHE: Hermitian indefinite, 2-D storage 00051 *> xHP: Hermitian indefinite packed 00052 *> xHB: Hermitian indefinite banded 00053 *> xSY: Symmetric indefinite, 2-D storage 00054 *> xSP: Symmetric indefinite packed 00055 *> xSB: Symmetric indefinite banded 00056 *> xTR: Triangular 00057 *> xTP: Triangular packed 00058 *> xTB: Triangular banded 00059 *> xQR: General m x n matrix 00060 *> xLQ: General m x n matrix 00061 *> xQL: General m x n matrix 00062 *> xRQ: General m x n matrix 00063 *> where the leading character indicates the precision. 00064 *> \endverbatim 00065 *> 00066 *> \param[in] XTYPE 00067 *> \verbatim 00068 *> XTYPE is CHARACTER*1 00069 *> Specifies how the exact solution X will be determined: 00070 *> = 'N': New solution; generate a random X. 00071 *> = 'C': Computed; use value of X on entry. 00072 *> \endverbatim 00073 *> 00074 *> \param[in] UPLO 00075 *> \verbatim 00076 *> UPLO is CHARACTER*1 00077 *> Used only if A is symmetric or triangular; specifies whether 00078 *> the upper or lower triangular part of the matrix A is stored. 00079 *> = 'U': Upper triangular 00080 *> = 'L': Lower triangular 00081 *> \endverbatim 00082 *> 00083 *> \param[in] TRANS 00084 *> \verbatim 00085 *> TRANS is CHARACTER*1 00086 *> Used only if A is nonsymmetric; specifies the operation 00087 *> applied to the matrix A. 00088 *> = 'N': B := A * X 00089 *> = 'T': B := A**T * X 00090 *> = 'C': B := A**H * X 00091 *> \endverbatim 00092 *> 00093 *> \param[in] M 00094 *> \verbatim 00095 *> M is INTEGER 00096 *> The number of rows of the matrix A. M >= 0. 00097 *> \endverbatim 00098 *> 00099 *> \param[in] N 00100 *> \verbatim 00101 *> N is INTEGER 00102 *> The number of columns of the matrix A. N >= 0. 00103 *> \endverbatim 00104 *> 00105 *> \param[in] KL 00106 *> \verbatim 00107 *> KL is INTEGER 00108 *> Used only if A is a band matrix; specifies the number of 00109 *> subdiagonals of A if A is a general band matrix or if A is 00110 *> symmetric or triangular and UPLO = 'L'; specifies the number 00111 *> of superdiagonals of A if A is symmetric or triangular and 00112 *> UPLO = 'U'. 0 <= KL <= M-1. 00113 *> \endverbatim 00114 *> 00115 *> \param[in] KU 00116 *> \verbatim 00117 *> KU is INTEGER 00118 *> Used only if A is a general band matrix or if A is 00119 *> triangular. 00120 *> 00121 *> If PATH = xGB, specifies the number of superdiagonals of A, 00122 *> and 0 <= KU <= N-1. 00123 *> 00124 *> If PATH = xTR, xTP, or xTB, specifies whether or not the 00125 *> matrix has unit diagonal: 00126 *> = 1: matrix has non-unit diagonal (default) 00127 *> = 2: matrix has unit diagonal 00128 *> \endverbatim 00129 *> 00130 *> \param[in] NRHS 00131 *> \verbatim 00132 *> NRHS is INTEGER 00133 *> The number of right hand side vectors in the system A*X = B. 00134 *> \endverbatim 00135 *> 00136 *> \param[in] A 00137 *> \verbatim 00138 *> A is COMPLEX array, dimension (LDA,N) 00139 *> The test matrix whose type is given by PATH. 00140 *> \endverbatim 00141 *> 00142 *> \param[in] LDA 00143 *> \verbatim 00144 *> LDA is INTEGER 00145 *> The leading dimension of the array A. 00146 *> If PATH = xGB, LDA >= KL+KU+1. 00147 *> If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1. 00148 *> Otherwise, LDA >= max(1,M). 00149 *> \endverbatim 00150 *> 00151 *> \param[in,out] X 00152 *> \verbatim 00153 *> X is or output) COMPLEX array, dimension (LDX,NRHS) 00154 *> On entry, if XTYPE = 'C' (for 'Computed'), then X contains 00155 *> the exact solution to the system of linear equations. 00156 *> On exit, if XTYPE = 'N' (for 'New'), then X is initialized 00157 *> with random values. 00158 *> \endverbatim 00159 *> 00160 *> \param[in] LDX 00161 *> \verbatim 00162 *> LDX is INTEGER 00163 *> The leading dimension of the array X. If TRANS = 'N', 00164 *> LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M). 00165 *> \endverbatim 00166 *> 00167 *> \param[out] B 00168 *> \verbatim 00169 *> B is COMPLEX array, dimension (LDB,NRHS) 00170 *> The right hand side vector(s) for the system of equations, 00171 *> computed from B = op(A) * X, where op(A) is determined by 00172 *> TRANS. 00173 *> \endverbatim 00174 *> 00175 *> \param[in] LDB 00176 *> \verbatim 00177 *> LDB is INTEGER 00178 *> The leading dimension of the array B. If TRANS = 'N', 00179 *> LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N). 00180 *> \endverbatim 00181 *> 00182 *> \param[in,out] ISEED 00183 *> \verbatim 00184 *> ISEED is INTEGER array, dimension (4) 00185 *> The seed vector for the random number generator (used in 00186 *> CLATMS). Modified on exit. 00187 *> \endverbatim 00188 *> 00189 *> \param[out] INFO 00190 *> \verbatim 00191 *> INFO is INTEGER 00192 *> = 0: successful exit 00193 *> < 0: if INFO = -i, the i-th argument had an illegal value 00194 *> \endverbatim 00195 * 00196 * Authors: 00197 * ======== 00198 * 00199 *> \author Univ. of Tennessee 00200 *> \author Univ. of California Berkeley 00201 *> \author Univ. of Colorado Denver 00202 *> \author NAG Ltd. 00203 * 00204 *> \date November 2011 00205 * 00206 *> \ingroup complex_eig 00207 * 00208 * ===================================================================== 00209 SUBROUTINE CLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, 00210 $ A, LDA, X, LDX, B, LDB, ISEED, INFO ) 00211 * 00212 * -- LAPACK test routine (version 3.4.0) -- 00213 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00214 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00215 * November 2011 00216 * 00217 * .. Scalar Arguments .. 00218 CHARACTER TRANS, UPLO, XTYPE 00219 CHARACTER*3 PATH 00220 INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS 00221 * .. 00222 * .. Array Arguments .. 00223 INTEGER ISEED( 4 ) 00224 COMPLEX A( LDA, * ), B( LDB, * ), X( LDX, * ) 00225 * .. 00226 * 00227 * ===================================================================== 00228 * 00229 * .. Parameters .. 00230 COMPLEX ONE, ZERO 00231 PARAMETER ( ONE = ( 1.0E+0, 0.0E+0 ), 00232 $ ZERO = ( 0.0E+0, 0.0E+0 ) ) 00233 * .. 00234 * .. Local Scalars .. 00235 LOGICAL BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI 00236 CHARACTER C1, DIAG 00237 CHARACTER*2 C2 00238 INTEGER J, MB, NX 00239 * .. 00240 * .. External Functions .. 00241 LOGICAL LSAME, LSAMEN 00242 EXTERNAL LSAME, LSAMEN 00243 * .. 00244 * .. External Subroutines .. 00245 EXTERNAL CGBMV, CGEMM, CHBMV, CHEMM, CHPMV, CLACPY, 00246 $ CLARNV, CSBMV, CSPMV, CSYMM, CTBMV, CTPMV, 00247 $ CTRMM, XERBLA 00248 * .. 00249 * .. Intrinsic Functions .. 00250 INTRINSIC MAX 00251 * .. 00252 * .. Executable Statements .. 00253 * 00254 * Test the input parameters. 00255 * 00256 INFO = 0 00257 C1 = PATH( 1: 1 ) 00258 C2 = PATH( 2: 3 ) 00259 TRAN = LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) 00260 NOTRAN = .NOT.TRAN 00261 GEN = LSAME( PATH( 2: 2 ), 'G' ) 00262 QRS = LSAME( PATH( 2: 2 ), 'Q' ) .OR. LSAME( PATH( 3: 3 ), 'Q' ) 00263 SYM = LSAME( PATH( 2: 2 ), 'P' ) .OR. 00264 $ LSAME( PATH( 2: 2 ), 'S' ) .OR. LSAME( PATH( 2: 2 ), 'H' ) 00265 TRI = LSAME( PATH( 2: 2 ), 'T' ) 00266 BAND = LSAME( PATH( 3: 3 ), 'B' ) 00267 IF( .NOT.LSAME( C1, 'Complex precision' ) ) THEN 00268 INFO = -1 00269 ELSE IF( .NOT.( LSAME( XTYPE, 'N' ) .OR. LSAME( XTYPE, 'C' ) ) ) 00270 $ THEN 00271 INFO = -2 00272 ELSE IF( ( SYM .OR. TRI ) .AND. .NOT. 00273 $ ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN 00274 INFO = -3 00275 ELSE IF( ( GEN.OR.QRS ) .AND. 00276 $ .NOT.( TRAN .OR. LSAME( TRANS, 'N' ) ) ) THEN 00277 INFO = -4 00278 ELSE IF( M.LT.0 ) THEN 00279 INFO = -5 00280 ELSE IF( N.LT.0 ) THEN 00281 INFO = -6 00282 ELSE IF( BAND .AND. KL.LT.0 ) THEN 00283 INFO = -7 00284 ELSE IF( BAND .AND. KU.LT.0 ) THEN 00285 INFO = -8 00286 ELSE IF( NRHS.LT.0 ) THEN 00287 INFO = -9 00288 ELSE IF( ( .NOT.BAND .AND. LDA.LT.MAX( 1, M ) ) .OR. 00289 $ ( BAND .AND. ( SYM .OR. TRI ) .AND. LDA.LT.KL+1 ) .OR. 00290 $ ( BAND .AND. GEN .AND. LDA.LT.KL+KU+1 ) ) THEN 00291 INFO = -11 00292 ELSE IF( ( NOTRAN .AND. LDX.LT.MAX( 1, N ) ) .OR. 00293 $ ( TRAN .AND. LDX.LT.MAX( 1, M ) ) ) THEN 00294 INFO = -13 00295 ELSE IF( ( NOTRAN .AND. LDB.LT.MAX( 1, M ) ) .OR. 00296 $ ( TRAN .AND. LDB.LT.MAX( 1, N ) ) ) THEN 00297 INFO = -15 00298 END IF 00299 IF( INFO.NE.0 ) THEN 00300 CALL XERBLA( 'CLARHS', -INFO ) 00301 RETURN 00302 END IF 00303 * 00304 * Initialize X to NRHS random vectors unless XTYPE = 'C'. 00305 * 00306 IF( TRAN ) THEN 00307 NX = M 00308 MB = N 00309 ELSE 00310 NX = N 00311 MB = M 00312 END IF 00313 IF( .NOT.LSAME( XTYPE, 'C' ) ) THEN 00314 DO 10 J = 1, NRHS 00315 CALL CLARNV( 2, ISEED, N, X( 1, J ) ) 00316 10 CONTINUE 00317 END IF 00318 * 00319 * Multiply X by op( A ) using an appropriate 00320 * matrix multiply routine. 00321 * 00322 IF( LSAMEN( 2, C2, 'GE' ) .OR. LSAMEN( 2, C2, 'QR' ) .OR. 00323 $ LSAMEN( 2, C2, 'LQ' ) .OR. LSAMEN( 2, C2, 'QL' ) .OR. 00324 $ LSAMEN( 2, C2, 'RQ' ) ) THEN 00325 * 00326 * General matrix 00327 * 00328 CALL CGEMM( TRANS, 'N', MB, NRHS, NX, ONE, A, LDA, X, LDX, 00329 $ ZERO, B, LDB ) 00330 * 00331 ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'HE' ) ) THEN 00332 * 00333 * Hermitian matrix, 2-D storage 00334 * 00335 CALL CHEMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, 00336 $ B, LDB ) 00337 * 00338 ELSE IF( LSAMEN( 2, C2, 'SY' ) ) THEN 00339 * 00340 * Symmetric matrix, 2-D storage 00341 * 00342 CALL CSYMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, 00343 $ B, LDB ) 00344 * 00345 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 00346 * 00347 * General matrix, band storage 00348 * 00349 DO 20 J = 1, NRHS 00350 CALL CGBMV( TRANS, M, N, KL, KU, ONE, A, LDA, X( 1, J ), 1, 00351 $ ZERO, B( 1, J ), 1 ) 00352 20 CONTINUE 00353 * 00354 ELSE IF( LSAMEN( 2, C2, 'PB' ) .OR. LSAMEN( 2, C2, 'HB' ) ) THEN 00355 * 00356 * Hermitian matrix, band storage 00357 * 00358 DO 30 J = 1, NRHS 00359 CALL CHBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, 00360 $ B( 1, J ), 1 ) 00361 30 CONTINUE 00362 * 00363 ELSE IF( LSAMEN( 2, C2, 'SB' ) ) THEN 00364 * 00365 * Symmetric matrix, band storage 00366 * 00367 DO 40 J = 1, NRHS 00368 CALL CSBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, 00369 $ B( 1, J ), 1 ) 00370 40 CONTINUE 00371 * 00372 ELSE IF( LSAMEN( 2, C2, 'PP' ) .OR. LSAMEN( 2, C2, 'HP' ) ) THEN 00373 * 00374 * Hermitian matrix, packed storage 00375 * 00376 DO 50 J = 1, NRHS 00377 CALL CHPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), 00378 $ 1 ) 00379 50 CONTINUE 00380 * 00381 ELSE IF( LSAMEN( 2, C2, 'SP' ) ) THEN 00382 * 00383 * Symmetric matrix, packed storage 00384 * 00385 DO 60 J = 1, NRHS 00386 CALL CSPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), 00387 $ 1 ) 00388 60 CONTINUE 00389 * 00390 ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN 00391 * 00392 * Triangular matrix. Note that for triangular matrices, 00393 * KU = 1 => non-unit triangular 00394 * KU = 2 => unit triangular 00395 * 00396 CALL CLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) 00397 IF( KU.EQ.2 ) THEN 00398 DIAG = 'U' 00399 ELSE 00400 DIAG = 'N' 00401 END IF 00402 CALL CTRMM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, 00403 $ LDB ) 00404 * 00405 ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN 00406 * 00407 * Triangular matrix, packed storage 00408 * 00409 CALL CLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) 00410 IF( KU.EQ.2 ) THEN 00411 DIAG = 'U' 00412 ELSE 00413 DIAG = 'N' 00414 END IF 00415 DO 70 J = 1, NRHS 00416 CALL CTPMV( UPLO, TRANS, DIAG, N, A, B( 1, J ), 1 ) 00417 70 CONTINUE 00418 * 00419 ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN 00420 * 00421 * Triangular matrix, banded storage 00422 * 00423 CALL CLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) 00424 IF( KU.EQ.2 ) THEN 00425 DIAG = 'U' 00426 ELSE 00427 DIAG = 'N' 00428 END IF 00429 DO 80 J = 1, NRHS 00430 CALL CTBMV( UPLO, TRANS, DIAG, N, KL, A, LDA, B( 1, J ), 1 ) 00431 80 CONTINUE 00432 * 00433 ELSE 00434 * 00435 * If none of the above, set INFO = -1 and return 00436 * 00437 INFO = -1 00438 CALL XERBLA( 'CLARHS', -INFO ) 00439 END IF 00440 * 00441 RETURN 00442 * 00443 * End of CLARHS 00444 * 00445 END