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