121 SUBROUTINE csytrs( UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
130 INTEGER INFO, LDA, LDB, N, NRHS
134 COMPLEX A( lda, * ), B( ldb, * )
141 parameter( one = ( 1.0e+0, 0.0e+0 ) )
146 COMPLEX 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(
'CSYTRS', -info )
180 IF( n.EQ.0 .OR. nrhs.EQ.0 )
200 IF( ipiv( k ).GT.0 )
THEN
208 $ CALL
cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
213 CALL
cgeru( k-1, nrhs, -one, a( 1, k ), 1, b( k, 1 ), ldb,
218 CALL
cscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
228 $ CALL
cswap( nrhs, b( k-1, 1 ), ldb, b( kp, 1 ), ldb )
233 CALL
cgeru( k-2, nrhs, -one, a( 1, k ), 1, b( k, 1 ), ldb,
235 CALL
cgeru( 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
cgemv(
'Transpose', k-1, nrhs, -one, b, ldb, a( 1, k ),
277 $ 1, one, b( k, 1 ), ldb )
283 $ CALL
cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
292 CALL
cgemv(
'Transpose', k-1, nrhs, -one, b, ldb, a( 1, k ),
293 $ 1, one, b( k, 1 ), ldb )
294 CALL
cgemv(
'Transpose', k-1, nrhs, -one, b, ldb,
295 $ a( 1, k+1 ), 1, one, b( k+1, 1 ), ldb )
301 $ CALL
cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
325 IF( ipiv( k ).GT.0 )
THEN
333 $ CALL
cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
339 $ CALL
cgeru( n-k, nrhs, -one, a( k+1, k ), 1, b( k, 1 ),
340 $ ldb, b( k+1, 1 ), ldb )
344 CALL
cscal( nrhs, one / a( k, k ), b( k, 1 ), ldb )
354 $ CALL
cswap( nrhs, b( k+1, 1 ), ldb, b( kp, 1 ), ldb )
360 CALL
cgeru( n-k-1, nrhs, -one, a( k+2, k ), 1, b( k, 1 ),
361 $ ldb, b( k+2, 1 ), ldb )
362 CALL
cgeru( 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
cgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
406 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
412 $ CALL
cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
422 CALL
cgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
423 $ ldb, a( k+1, k ), 1, one, b( k, 1 ), ldb )
424 CALL
cgemv(
'Transpose', n-k, nrhs, -one, b( k+1, 1 ),
425 $ ldb, a( k+1, k-1 ), 1, one, b( k-1, 1 ),
433 $ CALL
cswap( nrhs, b( k, 1 ), ldb, b( kp, 1 ), ldb )
subroutine cscal(N, CA, CX, INCX)
CSCAL
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine csytrs(UPLO, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CSYTRS
subroutine cgeru(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERU