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