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