209 SUBROUTINE clarhs( PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS,
210 $ a, lda, x, ldx,
b, ldb, iseed, info )
218 CHARACTER trans, uplo, xtype
220 INTEGER info, kl, ku, lda, ldb, ldx, m, n, nrhs
224 COMPLEX a( lda, * ),
b( ldb, * ), x( ldx, * )
231 parameter( one = ( 1.0e+0, 0.0e+0 ),
232 $ zero = ( 0.0e+0, 0.0e+0 ) )
235 LOGICAL band, gen, notran, qrs, sym, tran, tri
259 tran =
lsame( trans,
'T' ) .OR.
lsame( trans,
'C' )
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,
'Complex precision' ) )
THEN
269 ELSE IF( .NOT.(
lsame( xtype,
'N' ) .OR.
lsame( xtype,
'C' ) ) )
272 ELSE IF( ( sym .OR. tri ) .AND. .NOT.
273 $ (
lsame( uplo,
'U' ) .OR.
lsame( uplo,
'L' ) ) )
THEN
275 ELSE IF( ( gen.OR.qrs ) .AND.
276 $ .NOT.( tran .OR.
lsame( trans,
'N' ) ) )
THEN
278 ELSE IF( m.LT.0 )
THEN
280 ELSE IF( n.LT.0 )
THEN
282 ELSE IF( band .AND. kl.LT.0 )
THEN
284 ELSE IF( band .AND. ku.LT.0 )
THEN
286 ELSE IF( nrhs.LT.0 )
THEN
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
292 ELSE IF( ( notran .AND. ldx.LT.max( 1, n ) ) .OR.
293 $ ( tran .AND. ldx.LT.max( 1, m ) ) )
THEN
295 ELSE IF( ( notran .AND. ldb.LT.max( 1, m ) ) .OR.
296 $ ( tran .AND. ldb.LT.max( 1, n ) ) )
THEN
300 CALL
xerbla(
'CLARHS', -info )
313 IF( .NOT.
lsame( xtype,
'C' ) )
THEN
315 CALL
clarnv( 2, iseed, n, x( 1,
j ) )
322 IF(
lsamen( 2, c2,
'GE' ) .OR.
lsamen( 2, c2,
'QR' ) .OR.
324 $
lsamen( 2, c2,
'RQ' ) )
THEN
328 CALL
cgemm( trans,
'N', mb, nrhs, nx, one, a, lda, x, ldx,
331 ELSE IF(
lsamen( 2, c2,
'PO' ) .OR.
lsamen( 2, c2,
'HE' ) )
THEN
335 CALL
chemm(
'Left', uplo, n, nrhs, one, a, lda, x, ldx, zero,
338 ELSE IF(
lsamen( 2, c2,
'SY' ) )
THEN
342 CALL
csymm(
'Left', uplo, n, nrhs, one, a, lda, x, ldx, zero,
345 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
350 CALL
cgbmv( trans, m, n, kl, ku, one, a, lda, x( 1,
j ), 1,
351 $ zero,
b( 1,
j ), 1 )
354 ELSE IF(
lsamen( 2, c2,
'PB' ) .OR.
lsamen( 2, c2,
'HB' ) )
THEN
359 CALL
chbmv( uplo, n, kl, one, a, lda, x( 1,
j ), 1, zero,
363 ELSE IF(
lsamen( 2, c2,
'SB' ) )
THEN
368 CALL
csbmv( uplo, n, kl, one, a, lda, x( 1,
j ), 1, zero,
372 ELSE IF(
lsamen( 2, c2,
'PP' ) .OR.
lsamen( 2, c2,
'HP' ) )
THEN
377 CALL
chpmv( uplo, n, one, a, x( 1,
j ), 1, zero,
b( 1,
j ),
381 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
386 CALL
cspmv( uplo, n, one, a, x( 1,
j ), 1, zero,
b( 1,
j ),
390 ELSE IF(
lsamen( 2, c2,
'TR' ) )
THEN
396 CALL
clacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
402 CALL
ctrmm(
'Left', uplo, trans, diag, n, nrhs, one, a, lda,
b,
405 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
409 CALL
clacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
416 CALL
ctpmv( uplo, trans, diag, n, a,
b( 1,
j ), 1 )
419 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
423 CALL
clacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
430 CALL
ctbmv( uplo, trans, diag, n, kl, a, lda,
b( 1,
j ), 1 )
438 CALL
xerbla(
'CLARHS', -info )
subroutine ctpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
CTPMV
subroutine cgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGBMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRMM
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine chbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CHBMV
subroutine cspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
CSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix ...
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
logical function lsamen(N, CA, CB)
LSAMEN
subroutine chpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
CHPMV
subroutine clarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
CLARHS
subroutine clarnv(IDIST, ISEED, N, X)
CLARNV returns a vector of random numbers from a uniform or normal distribution.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine csbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CSBMV
subroutine ctbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
CTBMV
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM
subroutine chemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CHEMM
subroutine csymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CSYMM