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
LOGICAL function lsame(CA, CB)
LSAME
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
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