1*> \brief \b DLARHS 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* SUBROUTINE DLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, 12* A, LDA, X, LDX, B, LDB, ISEED, INFO ) 13* 14* .. Scalar Arguments .. 15* CHARACTER TRANS, UPLO, XTYPE 16* CHARACTER*3 PATH 17* INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS 18* .. 19* .. Array Arguments .. 20* INTEGER ISEED( 4 ) 21* DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> DLARHS chooses a set of NRHS random solution vectors and sets 31*> up the right hand sides for the linear system 32*> op( A ) * X = B, 33*> where op( A ) may be A or A' (transpose of A). 34*> \endverbatim 35* 36* Arguments: 37* ========== 38* 39*> \param[in] PATH 40*> \verbatim 41*> PATH is CHARACTER*3 42*> The type of the real matrix A. PATH may be given in any 43*> combination of upper and lower case. Valid types include 44*> xGE: General m x n matrix 45*> xGB: General banded matrix 46*> xPO: Symmetric positive definite, 2-D storage 47*> xPP: Symmetric positive definite packed 48*> xPB: Symmetric positive definite banded 49*> xSY: Symmetric indefinite, 2-D storage 50*> xSP: Symmetric indefinite packed 51*> xSB: Symmetric indefinite banded 52*> xTR: Triangular 53*> xTP: Triangular packed 54*> xTB: Triangular banded 55*> xQR: General m x n matrix 56*> xLQ: General m x n matrix 57*> xQL: General m x n matrix 58*> xRQ: General m x n matrix 59*> where the leading character indicates the precision. 60*> \endverbatim 61*> 62*> \param[in] XTYPE 63*> \verbatim 64*> XTYPE is CHARACTER*1 65*> Specifies how the exact solution X will be determined: 66*> = 'N': New solution; generate a random X. 67*> = 'C': Computed; use value of X on entry. 68*> \endverbatim 69*> 70*> \param[in] UPLO 71*> \verbatim 72*> UPLO is CHARACTER*1 73*> Specifies whether the upper or lower triangular part of the 74*> matrix A is stored, if A is symmetric. 75*> = 'U': Upper triangular 76*> = 'L': Lower triangular 77*> \endverbatim 78*> 79*> \param[in] TRANS 80*> \verbatim 81*> TRANS is CHARACTER*1 82*> Specifies the operation applied to the matrix A. 83*> = 'N': System is A * x = b 84*> = 'T': System is A'* x = b 85*> = 'C': System is A'* x = b 86*> \endverbatim 87*> 88*> \param[in] M 89*> \verbatim 90*> M is INTEGER 91*> The number or rows of the matrix A. M >= 0. 92*> \endverbatim 93*> 94*> \param[in] N 95*> \verbatim 96*> N is INTEGER 97*> The number of columns of the matrix A. N >= 0. 98*> \endverbatim 99*> 100*> \param[in] KL 101*> \verbatim 102*> KL is INTEGER 103*> Used only if A is a band matrix; specifies the number of 104*> subdiagonals of A if A is a general band matrix or if A is 105*> symmetric or triangular and UPLO = 'L'; specifies the number 106*> of superdiagonals of A if A is symmetric or triangular and 107*> UPLO = 'U'. 0 <= KL <= M-1. 108*> \endverbatim 109*> 110*> \param[in] KU 111*> \verbatim 112*> KU is INTEGER 113*> Used only if A is a general band matrix or if A is 114*> triangular. 115*> 116*> If PATH = xGB, specifies the number of superdiagonals of A, 117*> and 0 <= KU <= N-1. 118*> 119*> If PATH = xTR, xTP, or xTB, specifies whether or not the 120*> matrix has unit diagonal: 121*> = 1: matrix has non-unit diagonal (default) 122*> = 2: matrix has unit diagonal 123*> \endverbatim 124*> 125*> \param[in] NRHS 126*> \verbatim 127*> NRHS is INTEGER 128*> The number of right hand side vectors in the system A*X = B. 129*> \endverbatim 130*> 131*> \param[in] A 132*> \verbatim 133*> A is DOUBLE PRECISION array, dimension (LDA,N) 134*> The test matrix whose type is given by PATH. 135*> \endverbatim 136*> 137*> \param[in] LDA 138*> \verbatim 139*> LDA is INTEGER 140*> The leading dimension of the array A. 141*> If PATH = xGB, LDA >= KL+KU+1. 142*> If PATH = xPB, xSB, xHB, or xTB, LDA >= KL+1. 143*> Otherwise, LDA >= max(1,M). 144*> \endverbatim 145*> 146*> \param[in,out] X 147*> \verbatim 148*> X is or output) DOUBLE PRECISION array, dimension(LDX,NRHS) 149*> On entry, if XTYPE = 'C' (for 'Computed'), then X contains 150*> the exact solution to the system of linear equations. 151*> On exit, if XTYPE = 'N' (for 'New'), then X is initialized 152*> with random values. 153*> \endverbatim 154*> 155*> \param[in] LDX 156*> \verbatim 157*> LDX is INTEGER 158*> The leading dimension of the array X. If TRANS = 'N', 159*> LDX >= max(1,N); if TRANS = 'T', LDX >= max(1,M). 160*> \endverbatim 161*> 162*> \param[out] B 163*> \verbatim 164*> B is DOUBLE PRECISION array, dimension (LDB,NRHS) 165*> The right hand side vector(s) for the system of equations, 166*> computed from B = op(A) * X, where op(A) is determined by 167*> TRANS. 168*> \endverbatim 169*> 170*> \param[in] LDB 171*> \verbatim 172*> LDB is INTEGER 173*> The leading dimension of the array B. If TRANS = 'N', 174*> LDB >= max(1,M); if TRANS = 'T', LDB >= max(1,N). 175*> \endverbatim 176*> 177*> \param[in,out] ISEED 178*> \verbatim 179*> ISEED is INTEGER array, dimension (4) 180*> The seed vector for the random number generator (used in 181*> DLATMS). Modified on exit. 182*> \endverbatim 183*> 184*> \param[out] INFO 185*> \verbatim 186*> INFO is INTEGER 187*> = 0: successful exit 188*> < 0: if INFO = -i, the i-th argument had an illegal value 189*> \endverbatim 190* 191* Authors: 192* ======== 193* 194*> \author Univ. of Tennessee 195*> \author Univ. of California Berkeley 196*> \author Univ. of Colorado Denver 197*> \author NAG Ltd. 198* 199*> \date December 2016 200* 201*> \ingroup double_lin 202* 203* ===================================================================== 204 SUBROUTINE DLARHS( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, 205 $ A, LDA, X, LDX, B, LDB, ISEED, INFO ) 206* 207* -- LAPACK test routine (version 3.7.0) -- 208* -- LAPACK is a software package provided by Univ. of Tennessee, -- 209* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 210* December 2016 211* 212* .. Scalar Arguments .. 213 CHARACTER TRANS, UPLO, XTYPE 214 CHARACTER*3 PATH 215 INTEGER INFO, KL, KU, LDA, LDB, LDX, M, N, NRHS 216* .. 217* .. Array Arguments .. 218 INTEGER ISEED( 4 ) 219 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), X( LDX, * ) 220* .. 221* 222* ===================================================================== 223* 224* .. Parameters .. 225 DOUBLE PRECISION ONE, ZERO 226 PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 ) 227* .. 228* .. Local Scalars .. 229 LOGICAL BAND, GEN, NOTRAN, QRS, SYM, TRAN, TRI 230 CHARACTER C1, DIAG 231 CHARACTER*2 C2 232 INTEGER J, MB, NX 233* .. 234* .. External Functions .. 235 LOGICAL LSAME, LSAMEN 236 EXTERNAL LSAME, LSAMEN 237* .. 238* .. External Subroutines .. 239 EXTERNAL DGBMV, DGEMM, DLACPY, DLARNV, DSBMV, DSPMV, 240 $ DSYMM, DTBMV, DTPMV, DTRMM, XERBLA 241* .. 242* .. Intrinsic Functions .. 243 INTRINSIC MAX 244* .. 245* .. Executable Statements .. 246* 247* Test the input parameters. 248* 249 INFO = 0 250 C1 = PATH( 1: 1 ) 251 C2 = PATH( 2: 3 ) 252 TRAN = LSAME( TRANS, 'T' ) .OR. LSAME( TRANS, 'C' ) 253 NOTRAN = .NOT.TRAN 254 GEN = LSAME( PATH( 2: 2 ), 'G' ) 255 QRS = LSAME( PATH( 2: 2 ), 'Q' ) .OR. LSAME( PATH( 3: 3 ), 'Q' ) 256 SYM = LSAME( PATH( 2: 2 ), 'P' ) .OR. LSAME( PATH( 2: 2 ), 'S' ) 257 TRI = LSAME( PATH( 2: 2 ), 'T' ) 258 BAND = LSAME( PATH( 3: 3 ), 'B' ) 259 IF( .NOT.LSAME( C1, 'Double precision' ) ) THEN 260 INFO = -1 261 ELSE IF( .NOT.( LSAME( XTYPE, 'N' ) .OR. LSAME( XTYPE, 'C' ) ) ) 262 $ THEN 263 INFO = -2 264 ELSE IF( ( SYM .OR. TRI ) .AND. .NOT. 265 $ ( LSAME( UPLO, 'U' ) .OR. LSAME( UPLO, 'L' ) ) ) THEN 266 INFO = -3 267 ELSE IF( ( GEN .OR. QRS ) .AND. .NOT. 268 $ ( TRAN .OR. LSAME( TRANS, 'N' ) ) ) THEN 269 INFO = -4 270 ELSE IF( M.LT.0 ) THEN 271 INFO = -5 272 ELSE IF( N.LT.0 ) THEN 273 INFO = -6 274 ELSE IF( BAND .AND. KL.LT.0 ) THEN 275 INFO = -7 276 ELSE IF( BAND .AND. KU.LT.0 ) THEN 277 INFO = -8 278 ELSE IF( NRHS.LT.0 ) THEN 279 INFO = -9 280 ELSE IF( ( .NOT.BAND .AND. LDA.LT.MAX( 1, M ) ) .OR. 281 $ ( BAND .AND. ( SYM .OR. TRI ) .AND. LDA.LT.KL+1 ) .OR. 282 $ ( BAND .AND. GEN .AND. LDA.LT.KL+KU+1 ) ) THEN 283 INFO = -11 284 ELSE IF( ( NOTRAN .AND. LDX.LT.MAX( 1, N ) ) .OR. 285 $ ( TRAN .AND. LDX.LT.MAX( 1, M ) ) ) THEN 286 INFO = -13 287 ELSE IF( ( NOTRAN .AND. LDB.LT.MAX( 1, M ) ) .OR. 288 $ ( TRAN .AND. LDB.LT.MAX( 1, N ) ) ) THEN 289 INFO = -15 290 END IF 291 IF( INFO.NE.0 ) THEN 292 CALL XERBLA( 'DLARHS', -INFO ) 293 RETURN 294 END IF 295* 296* Initialize X to NRHS random vectors unless XTYPE = 'C'. 297* 298 IF( TRAN ) THEN 299 NX = M 300 MB = N 301 ELSE 302 NX = N 303 MB = M 304 END IF 305 IF( .NOT.LSAME( XTYPE, 'C' ) ) THEN 306 DO 10 J = 1, NRHS 307 CALL DLARNV( 2, ISEED, N, X( 1, J ) ) 308 10 CONTINUE 309 END IF 310* 311* Multiply X by op( A ) using an appropriate 312* matrix multiply routine. 313* 314 IF( LSAMEN( 2, C2, 'GE' ) .OR. LSAMEN( 2, C2, 'QR' ) .OR. 315 $ LSAMEN( 2, C2, 'LQ' ) .OR. LSAMEN( 2, C2, 'QL' ) .OR. 316 $ LSAMEN( 2, C2, 'RQ' ) ) THEN 317* 318* General matrix 319* 320 CALL DGEMM( TRANS, 'N', MB, NRHS, NX, ONE, A, LDA, X, LDX, 321 $ ZERO, B, LDB ) 322* 323 ELSE IF( LSAMEN( 2, C2, 'PO' ) .OR. LSAMEN( 2, C2, 'SY' ) ) THEN 324* 325* Symmetric matrix, 2-D storage 326* 327 CALL DSYMM( 'Left', UPLO, N, NRHS, ONE, A, LDA, X, LDX, ZERO, 328 $ B, LDB ) 329* 330 ELSE IF( LSAMEN( 2, C2, 'GB' ) ) THEN 331* 332* General matrix, band storage 333* 334 DO 20 J = 1, NRHS 335 CALL DGBMV( TRANS, MB, NX, KL, KU, ONE, A, LDA, X( 1, J ), 336 $ 1, ZERO, B( 1, J ), 1 ) 337 20 CONTINUE 338* 339 ELSE IF( LSAMEN( 2, C2, 'PB' ) ) THEN 340* 341* Symmetric matrix, band storage 342* 343 DO 30 J = 1, NRHS 344 CALL DSBMV( UPLO, N, KL, ONE, A, LDA, X( 1, J ), 1, ZERO, 345 $ B( 1, J ), 1 ) 346 30 CONTINUE 347* 348 ELSE IF( LSAMEN( 2, C2, 'PP' ) .OR. LSAMEN( 2, C2, 'SP' ) ) THEN 349* 350* Symmetric matrix, packed storage 351* 352 DO 40 J = 1, NRHS 353 CALL DSPMV( UPLO, N, ONE, A, X( 1, J ), 1, ZERO, B( 1, J ), 354 $ 1 ) 355 40 CONTINUE 356* 357 ELSE IF( LSAMEN( 2, C2, 'TR' ) ) THEN 358* 359* Triangular matrix. Note that for triangular matrices, 360* KU = 1 => non-unit triangular 361* KU = 2 => unit triangular 362* 363 CALL DLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) 364 IF( KU.EQ.2 ) THEN 365 DIAG = 'U' 366 ELSE 367 DIAG = 'N' 368 END IF 369 CALL DTRMM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B, 370 $ LDB ) 371* 372 ELSE IF( LSAMEN( 2, C2, 'TP' ) ) THEN 373* 374* Triangular matrix, packed storage 375* 376 CALL DLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) 377 IF( KU.EQ.2 ) THEN 378 DIAG = 'U' 379 ELSE 380 DIAG = 'N' 381 END IF 382 DO 50 J = 1, NRHS 383 CALL DTPMV( UPLO, TRANS, DIAG, N, A, B( 1, J ), 1 ) 384 50 CONTINUE 385* 386 ELSE IF( LSAMEN( 2, C2, 'TB' ) ) THEN 387* 388* Triangular matrix, banded storage 389* 390 CALL DLACPY( 'Full', N, NRHS, X, LDX, B, LDB ) 391 IF( KU.EQ.2 ) THEN 392 DIAG = 'U' 393 ELSE 394 DIAG = 'N' 395 END IF 396 DO 60 J = 1, NRHS 397 CALL DTBMV( UPLO, TRANS, DIAG, N, KL, A, LDA, B( 1, J ), 1 ) 398 60 CONTINUE 399* 400 ELSE 401* 402* If PATH is none of the above, return with an error code. 403* 404 INFO = -1 405 CALL XERBLA( 'DLARHS', -INFO ) 406 END IF 407* 408 RETURN 409* 410* End of DLARHS 411* 412 END 413