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