223 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			223 lines
		
	
	
		
			5.8 KiB
		
	
	
	
		
			Fortran
		
	
	
	
| *> \brief \b ZGETRS
 | |
| *
 | |
| *  =========== DOCUMENTATION ===========
 | |
| *
 | |
| * Online html documentation available at
 | |
| *            http://www.netlib.org/lapack/explore-html/
 | |
| *
 | |
| *> \htmlonly
 | |
| *> Download ZGETRS + dependencies
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zgetrs.f">
 | |
| *> [TGZ]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zgetrs.f">
 | |
| *> [ZIP]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zgetrs.f">
 | |
| *> [TXT]</a>
 | |
| *> \endhtmlonly
 | |
| *
 | |
| *  Definition:
 | |
| *  ===========
 | |
| *
 | |
| *       SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
 | |
| *
 | |
| *       .. Scalar Arguments ..
 | |
| *       CHARACTER          TRANS
 | |
| *       INTEGER            INFO, LDA, LDB, N, NRHS
 | |
| *       ..
 | |
| *       .. Array Arguments ..
 | |
| *       INTEGER            IPIV( * )
 | |
| *       COMPLEX*16         A( LDA, * ), B( LDB, * )
 | |
| *       ..
 | |
| *
 | |
| *
 | |
| *> \par Purpose:
 | |
| *  =============
 | |
| *>
 | |
| *> \verbatim
 | |
| *>
 | |
| *> ZGETRS solves a system of linear equations
 | |
| *>    A * X = B,  A**T * X = B,  or  A**H * X = B
 | |
| *> with a general N-by-N matrix A using the LU factorization computed
 | |
| *> by ZGETRF.
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Arguments:
 | |
| *  ==========
 | |
| *
 | |
| *> \param[in] TRANS
 | |
| *> \verbatim
 | |
| *>          TRANS is CHARACTER*1
 | |
| *>          Specifies the form of the system of equations:
 | |
| *>          = 'N':  A * X = B     (No transpose)
 | |
| *>          = 'T':  A**T * X = B  (Transpose)
 | |
| *>          = 'C':  A**H * X = B  (Conjugate transpose)
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] N
 | |
| *> \verbatim
 | |
| *>          N is INTEGER
 | |
| *>          The order of the matrix A.  N >= 0.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] NRHS
 | |
| *> \verbatim
 | |
| *>          NRHS is INTEGER
 | |
| *>          The number of right hand sides, i.e., the number of columns
 | |
| *>          of the matrix B.  NRHS >= 0.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] A
 | |
| *> \verbatim
 | |
| *>          A is COMPLEX*16 array, dimension (LDA,N)
 | |
| *>          The factors L and U from the factorization A = P*L*U
 | |
| *>          as computed by ZGETRF.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] LDA
 | |
| *> \verbatim
 | |
| *>          LDA is INTEGER
 | |
| *>          The leading dimension of the array A.  LDA >= max(1,N).
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] IPIV
 | |
| *> \verbatim
 | |
| *>          IPIV is INTEGER array, dimension (N)
 | |
| *>          The pivot indices from ZGETRF; for 1<=i<=N, row i of the
 | |
| *>          matrix was interchanged with row IPIV(i).
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in,out] B
 | |
| *> \verbatim
 | |
| *>          B is COMPLEX*16 array, dimension (LDB,NRHS)
 | |
| *>          On entry, the right hand side matrix B.
 | |
| *>          On exit, the solution matrix X.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] LDB
 | |
| *> \verbatim
 | |
| *>          LDB is INTEGER
 | |
| *>          The leading dimension of the array B.  LDB >= max(1,N).
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[out] INFO
 | |
| *> \verbatim
 | |
| *>          INFO is INTEGER
 | |
| *>          = 0:  successful exit
 | |
| *>          < 0:  if INFO = -i, the i-th argument had an illegal value
 | |
| *> \endverbatim
 | |
| *
 | |
| *  Authors:
 | |
| *  ========
 | |
| *
 | |
| *> \author Univ. of Tennessee
 | |
| *> \author Univ. of California Berkeley
 | |
| *> \author Univ. of Colorado Denver
 | |
| *> \author NAG Ltd.
 | |
| *
 | |
| *> \ingroup complex16GEcomputational
 | |
| *
 | |
| *  =====================================================================
 | |
|       SUBROUTINE ZGETRS( TRANS, N, NRHS, A, LDA, IPIV, B, LDB, INFO )
 | |
| *
 | |
| *  -- LAPACK computational routine --
 | |
| *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 | |
| *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 | |
| *
 | |
| *     .. Scalar Arguments ..
 | |
|       CHARACTER          TRANS
 | |
|       INTEGER            INFO, LDA, LDB, N, NRHS
 | |
| *     ..
 | |
| *     .. Array Arguments ..
 | |
|       INTEGER            IPIV( * )
 | |
|       COMPLEX*16         A( LDA, * ), B( LDB, * )
 | |
| *     ..
 | |
| *
 | |
| *  =====================================================================
 | |
| *
 | |
| *     .. Parameters ..
 | |
|       COMPLEX*16         ONE
 | |
|       PARAMETER          ( ONE = ( 1.0D+0, 0.0D+0 ) )
 | |
| *     ..
 | |
| *     .. Local Scalars ..
 | |
|       LOGICAL            NOTRAN
 | |
| *     ..
 | |
| *     .. External Functions ..
 | |
|       LOGICAL            LSAME
 | |
|       EXTERNAL           LSAME
 | |
| *     ..
 | |
| *     .. External Subroutines ..
 | |
|       EXTERNAL           XERBLA, ZLASWP, ZTRSM
 | |
| *     ..
 | |
| *     .. Intrinsic Functions ..
 | |
|       INTRINSIC          MAX
 | |
| *     ..
 | |
| *     .. Executable Statements ..
 | |
| *
 | |
| *     Test the input parameters.
 | |
| *
 | |
|       INFO = 0
 | |
|       NOTRAN = LSAME( TRANS, 'N' )
 | |
|       IF( .NOT.NOTRAN .AND. .NOT.LSAME( TRANS, 'T' ) .AND. .NOT.
 | |
|      $    LSAME( TRANS, 'C' ) ) THEN
 | |
|          INFO = -1
 | |
|       ELSE IF( N.LT.0 ) THEN
 | |
|          INFO = -2
 | |
|       ELSE IF( NRHS.LT.0 ) THEN
 | |
|          INFO = -3
 | |
|       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
 | |
|          INFO = -5
 | |
|       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
 | |
|          INFO = -8
 | |
|       END IF
 | |
|       IF( INFO.NE.0 ) THEN
 | |
|          CALL XERBLA( 'ZGETRS', -INFO )
 | |
|          RETURN
 | |
|       END IF
 | |
| *
 | |
| *     Quick return if possible
 | |
| *
 | |
|       IF( N.EQ.0 .OR. NRHS.EQ.0 )
 | |
|      $   RETURN
 | |
| *
 | |
|       IF( NOTRAN ) THEN
 | |
| *
 | |
| *        Solve A * X = B.
 | |
| *
 | |
| *        Apply row interchanges to the right hand sides.
 | |
| *
 | |
|          CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, 1 )
 | |
| *
 | |
| *        Solve L*X = B, overwriting B with X.
 | |
| *
 | |
|          CALL ZTRSM( 'Left', 'Lower', 'No transpose', 'Unit', N, NRHS,
 | |
|      $               ONE, A, LDA, B, LDB )
 | |
| *
 | |
| *        Solve U*X = B, overwriting B with X.
 | |
| *
 | |
|          CALL ZTRSM( 'Left', 'Upper', 'No transpose', 'Non-unit', N,
 | |
|      $               NRHS, ONE, A, LDA, B, LDB )
 | |
|       ELSE
 | |
| *
 | |
| *        Solve A**T * X = B  or A**H * X = B.
 | |
| *
 | |
| *        Solve U**T *X = B or U**H *X = B, overwriting B with X.
 | |
| *
 | |
|          CALL ZTRSM( 'Left', 'Upper', TRANS, 'Non-unit', N, NRHS, ONE,
 | |
|      $               A, LDA, B, LDB )
 | |
| *
 | |
| *        Solve L**T *X = B, or L**H *X = B overwriting B with X.
 | |
| *
 | |
|          CALL ZTRSM( 'Left', 'Lower', TRANS, 'Unit', N, NRHS, ONE, A,
 | |
|      $               LDA, B, LDB )
 | |
| *
 | |
| *        Apply row interchanges to the solution vectors.
 | |
| *
 | |
|          CALL ZLASWP( NRHS, B, LDB, 1, N, IPIV, -1 )
 | |
|       END IF
 | |
| *
 | |
|       RETURN
 | |
| *
 | |
| *     End of ZGETRS
 | |
| *
 | |
|       END
 |