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