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
 |