120 SUBROUTINE zgetrs( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
128 INTEGER INFO, LDA, LDB, N, NRHS
132 COMPLEX*16 A( LDA, * ), B( LDB, * )
139 parameter( one = ( 1.0d+0, 0.0d+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(
'ZGETRS', -info )
179 IF( n.EQ.0 .OR. nrhs.EQ.0 )
188 CALL zlaswp( nrhs, b, ldb, 1, n, ipiv, 1 )
192 CALL ztrsm(
'Left',
'Lower',
'No transpose',
'Unit', n, nrhs,
193 $ one, a, lda, b, ldb )
197 CALL ztrsm(
'Left',
'Upper',
'No transpose',
'Non-unit', n,
198 $ nrhs, one, a, lda, b, ldb )
205 CALL ztrsm(
'Left',
'Upper', trans,
'Non-unit', n, nrhs, one,
210 CALL ztrsm(
'Left',
'Lower', trans,
'Unit', n, nrhs, one, a,
215 CALL zlaswp( nrhs, b, ldb, 1, n, ipiv, -1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ztrsm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
ZTRSM
subroutine zgetrs(TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO)
ZGETRS
subroutine zlaswp(N, A, LDA, K1, K2, IPIV, INCX)
ZLASWP performs a series of row interchanges on a general rectangular matrix.