209 SUBROUTINE zlarhs( 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*16 a( lda, * ),
b( ldb, * ), x( ldx, * )
231 parameter( one = ( 1.0d+0, 0.0d+0 ),
232 $ zero = ( 0.0d+0, 0.0d+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,
'Zomplex 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. .NOT.
276 $ ( 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(
'ZLARHS', -info )
313 IF( .NOT.
lsame( xtype,
'C' ) )
THEN
315 CALL
zlarnv( 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
zgemm( 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
zhemm(
'Left', uplo, n, nrhs, one, a, lda, x, ldx, zero,
338 ELSE IF(
lsamen( 2, c2,
'SY' ) )
THEN
342 CALL
zsymm(
'Left', uplo, n, nrhs, one, a, lda, x, ldx, zero,
345 ELSE IF(
lsamen( 2, c2,
'GB' ) )
THEN
350 CALL
zgbmv( 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
zhbmv( uplo, n, kl, one, a, lda, x( 1,
j ), 1, zero,
363 ELSE IF(
lsamen( 2, c2,
'SB' ) )
THEN
368 CALL
zsbmv( 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
zhpmv( uplo, n, one, a, x( 1,
j ), 1, zero,
b( 1,
j ),
381 ELSE IF(
lsamen( 2, c2,
'SP' ) )
THEN
386 CALL
zspmv( uplo, n, one, a, x( 1,
j ), 1, zero,
b( 1,
j ),
390 ELSE IF(
lsamen( 2, c2,
'TR' ) )
THEN
396 CALL
zlacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
402 CALL
ztrmm(
'Left', uplo, trans, diag, n, nrhs, one, a, lda,
b,
405 ELSE IF(
lsamen( 2, c2,
'TP' ) )
THEN
409 CALL
zlacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
416 CALL
ztpmv( uplo, trans, diag, n, a,
b( 1,
j ), 1 )
419 ELSE IF(
lsamen( 2, c2,
'TB' ) )
THEN
423 CALL
zlacpy(
'Full', n, nrhs, x, ldx,
b, ldb )
430 CALL
ztbmv( uplo, trans, diag, n, kl, a, lda,
b( 1,
j ), 1 )
438 CALL
xerbla(
'ZLARHS', -info )
subroutine zsbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZSBMV
subroutine ztbmv(UPLO, TRANS, DIAG, N, K, A, LDA, X, INCX)
ZTBMV
subroutine zlacpy(UPLO, M, N, A, LDA, B, LDB)
ZLACPY copies all or part of one two-dimensional array to another.
subroutine ztpmv(UPLO, TRANS, DIAG, N, AP, X, INCX)
ZTPMV
subroutine zspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
ZSPMV computes a matrix-vector product for complex vectors using a complex symmetric packed matrix ...
subroutine zgbmv(TRANS, M, N, KL, KU, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGBMV
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlarhs(PATH, XTYPE, UPLO, TRANS, M, N, KL, KU, NRHS, A, LDA, X, LDX, B, LDB, ISEED, INFO)
ZLARHS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine zsymm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZSYMM
logical function lsamen(N, CA, CB)
LSAMEN
subroutine zlarnv(IDIST, ISEED, N, X)
ZLARNV 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 zhemm(SIDE, UPLO, M, N, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZHEMM
subroutine zhbmv(UPLO, N, K, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZHBMV
subroutine zhpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
ZHPMV
subroutine ztrmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRMM