121 SUBROUTINE zsytrs( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
130 INTEGER info, lda, ldb, n, nrhs
134 COMPLEX*16 a( lda, * ),
b( ldb, * )
141 parameter( one = ( 1.0d+0, 0.0d+0 ) )
146 COMPLEX*16 ak, akm1, akm1k, bk, bkm1, denom
161 upper =
lsame( uplo,
'U' )
162 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
164 ELSE IF( n.LT.0 )
THEN
166 ELSE IF( nrhs.LT.0 )
THEN
168 ELSE IF( lda.LT.max( 1, n ) )
THEN
170 ELSE IF( ldb.LT.max( 1, n ) )
THEN
174 CALL
xerbla(
'ZSYTRS', -info )
180 IF( n.EQ.0 .OR. nrhs.EQ.0 )
200 IF( ipiv( k ).GT.0 )
THEN
208 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
213 CALL
zgeru( k-1, nrhs, -one, a( 1, k ), 1,
b( k, 1 ), ldb,
218 CALL
zscal( nrhs, one / a( k, k ),
b( k, 1 ), ldb )
228 $ CALL
zswap( nrhs,
b( k-1, 1 ), ldb,
b( kp, 1 ), ldb )
233 CALL
zgeru( k-2, nrhs, -one, a( 1, k ), 1,
b( k, 1 ), ldb,
235 CALL
zgeru( k-2, nrhs, -one, a( 1, k-1 ), 1,
b( k-1, 1 ),
236 $ ldb,
b( 1, 1 ), ldb )
241 akm1 = a( k-1, k-1 ) / akm1k
242 ak = a( k, k ) / akm1k
243 denom = akm1*ak - one
245 bkm1 =
b( k-1,
j ) / akm1k
246 bk =
b( k,
j ) / akm1k
247 b( k-1,
j ) = ( ak*bkm1-bk ) / denom
248 b( k,
j ) = ( akm1*bk-bkm1 ) / denom
269 IF( ipiv( k ).GT.0 )
THEN
276 CALL
zgemv(
'Transpose', k-1, nrhs, -one,
b, ldb, a( 1, k ),
277 $ 1, one,
b( k, 1 ), ldb )
283 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
292 CALL
zgemv(
'Transpose', k-1, nrhs, -one,
b, ldb, a( 1, k ),
293 $ 1, one,
b( k, 1 ), ldb )
294 CALL
zgemv(
'Transpose', k-1, nrhs, -one,
b, ldb,
295 $ a( 1, k+1 ), 1, one,
b( k+1, 1 ), ldb )
301 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
325 IF( ipiv( k ).GT.0 )
THEN
333 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
339 $ CALL
zgeru( n-k, nrhs, -one, a( k+1, k ), 1,
b( k, 1 ),
340 $ ldb,
b( k+1, 1 ), ldb )
344 CALL
zscal( nrhs, one / a( k, k ),
b( k, 1 ), ldb )
354 $ CALL
zswap( nrhs,
b( k+1, 1 ), ldb,
b( kp, 1 ), ldb )
360 CALL
zgeru( n-k-1, nrhs, -one, a( k+2, k ), 1,
b( k, 1 ),
361 $ ldb,
b( k+2, 1 ), ldb )
362 CALL
zgeru( n-k-1, nrhs, -one, a( k+2, k+1 ), 1,
363 $
b( k+1, 1 ), ldb,
b( k+2, 1 ), ldb )
369 akm1 = a( k, k ) / akm1k
370 ak = a( k+1, k+1 ) / akm1k
371 denom = akm1*ak - one
373 bkm1 =
b( k,
j ) / akm1k
374 bk =
b( k+1,
j ) / akm1k
375 b( k,
j ) = ( ak*bkm1-bk ) / denom
376 b( k+1,
j ) = ( akm1*bk-bkm1 ) / denom
397 IF( ipiv( k ).GT.0 )
THEN
405 $ CALL
zgemv(
'Transpose', n-k, nrhs, -one,
b( k+1, 1 ),
406 $ ldb, a( k+1, k ), 1, one,
b( k, 1 ), ldb )
412 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
422 CALL
zgemv(
'Transpose', n-k, nrhs, -one,
b( k+1, 1 ),
423 $ ldb, a( k+1, k ), 1, one,
b( k, 1 ), ldb )
424 CALL
zgemv(
'Transpose', n-k, nrhs, -one,
b( k+1, 1 ),
425 $ ldb, a( k+1, k-1 ), 1, one,
b( k-1, 1 ),
433 $ CALL
zswap( nrhs,
b( k, 1 ), ldb,
b( kp, 1 ), ldb )
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
logical function lsame(CA, CB)
LSAME
subroutine zsytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZSYTRS
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL
subroutine zgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERU