120 SUBROUTINE cgetrs( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
128 INTEGER INFO, LDA, LDB, N, NRHS
132 COMPLEX A( LDA, * ), B( LDB, * )
139 parameter( one = ( 1.0e+0, 0.0e+0 ) )
159 notran = lsame( trans,
'N' )
160 IF( .NOT.notran .AND. .NOT.lsame( trans,
'T' ) .AND. .NOT.
161 $ lsame( trans,
'C' ) )
THEN
163 ELSE IF( n.LT.0 )
THEN
165 ELSE IF( nrhs.LT.0 )
THEN
167 ELSE IF( lda.LT.max( 1, n ) )
THEN
169 ELSE IF( ldb.LT.max( 1, n ) )
THEN
173 CALL xerbla(
'CGETRS', -info )
179 IF( n.EQ.0 .OR. nrhs.EQ.0 )
188 CALL claswp( nrhs, b, ldb, 1, n, ipiv, 1 )
192 CALL ctrsm(
'Left',
'Lower',
'No transpose',
'Unit', n, nrhs,
193 $ one, a, lda, b, ldb )
197 CALL ctrsm(
'Left',
'Upper',
'No transpose',
'Non-unit', n,
198 $ nrhs, one, a, lda, b, ldb )
205 CALL ctrsm(
'Left',
'Upper', trans,
'Non-unit', n, nrhs, one,
210 CALL ctrsm(
'Left',
'Lower', trans,
'Unit', n, nrhs, one, a,
215 CALL claswp( nrhs, b, ldb, 1, n, ipiv, -1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
CTRSM
subroutine cgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
CGETRS
subroutine claswp(N, A, LDA, K1, K2, IPIV, INCX)
CLASWP performs a series of row interchanges on a general rectangular matrix.