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