221 lines
		
	
	
		
			5.9 KiB
		
	
	
	
		
			Fortran
		
	
	
	
			
		
		
	
	
			221 lines
		
	
	
		
			5.9 KiB
		
	
	
	
		
			Fortran
		
	
	
	
| *> \brief \b SGTTRS
 | |
| *
 | |
| *  =========== DOCUMENTATION ===========
 | |
| *
 | |
| * Online html documentation available at
 | |
| *            http://www.netlib.org/lapack/explore-html/
 | |
| *
 | |
| *> \htmlonly
 | |
| *> Download SGTTRS + dependencies
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/sgttrs.f">
 | |
| *> [TGZ]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/sgttrs.f">
 | |
| *> [ZIP]</a>
 | |
| *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/sgttrs.f">
 | |
| *> [TXT]</a>
 | |
| *> \endhtmlonly
 | |
| *
 | |
| *  Definition:
 | |
| *  ===========
 | |
| *
 | |
| *       SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB,
 | |
| *                          INFO )
 | |
| *
 | |
| *       .. Scalar Arguments ..
 | |
| *       CHARACTER          TRANS
 | |
| *       INTEGER            INFO, LDB, N, NRHS
 | |
| *       ..
 | |
| *       .. Array Arguments ..
 | |
| *       INTEGER            IPIV( * )
 | |
| *       REAL               B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
 | |
| *       ..
 | |
| *
 | |
| *
 | |
| *> \par Purpose:
 | |
| *  =============
 | |
| *>
 | |
| *> \verbatim
 | |
| *>
 | |
| *> SGTTRS solves one of the systems of equations
 | |
| *>    A*X = B  or  A**T*X = B,
 | |
| *> with a tridiagonal matrix A using the LU factorization computed
 | |
| *> by SGTTRF.
 | |
| *> \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**T* X = B  (Conjugate transpose = Transpose)
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] N
 | |
| *> \verbatim
 | |
| *>          N is INTEGER
 | |
| *>          The order of the matrix A.
 | |
| *> \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] DL
 | |
| *> \verbatim
 | |
| *>          DL is REAL array, dimension (N-1)
 | |
| *>          The (n-1) multipliers that define the matrix L from the
 | |
| *>          LU factorization of A.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] D
 | |
| *> \verbatim
 | |
| *>          D is REAL array, dimension (N)
 | |
| *>          The n diagonal elements of the upper triangular matrix U from
 | |
| *>          the LU factorization of A.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] DU
 | |
| *> \verbatim
 | |
| *>          DU is REAL array, dimension (N-1)
 | |
| *>          The (n-1) elements of the first super-diagonal of U.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] DU2
 | |
| *> \verbatim
 | |
| *>          DU2 is REAL array, dimension (N-2)
 | |
| *>          The (n-2) elements of the second super-diagonal of U.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in] IPIV
 | |
| *> \verbatim
 | |
| *>          IPIV is INTEGER array, dimension (N)
 | |
| *>          The pivot indices; for 1 <= i <= n, row i of the matrix was
 | |
| *>          interchanged with row IPIV(i).  IPIV(i) will always be either
 | |
| *>          i or i+1; IPIV(i) = i indicates a row interchange was not
 | |
| *>          required.
 | |
| *> \endverbatim
 | |
| *>
 | |
| *> \param[in,out] B
 | |
| *> \verbatim
 | |
| *>          B is REAL array, dimension (LDB,NRHS)
 | |
| *>          On entry, the matrix of right hand side vectors B.
 | |
| *>          On exit, B is overwritten by the solution vectors 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 realGTcomputational
 | |
| *
 | |
| *  =====================================================================
 | |
|       SUBROUTINE SGTTRS( TRANS, N, NRHS, DL, D, DU, DU2, 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, LDB, N, NRHS
 | |
| *     ..
 | |
| *     .. Array Arguments ..
 | |
|       INTEGER            IPIV( * )
 | |
|       REAL               B( LDB, * ), D( * ), DL( * ), DU( * ), DU2( * )
 | |
| *     ..
 | |
| *
 | |
| *  =====================================================================
 | |
| *
 | |
| *     .. Local Scalars ..
 | |
|       LOGICAL            NOTRAN
 | |
|       INTEGER            ITRANS, J, JB, NB
 | |
| *     ..
 | |
| *     .. External Functions ..
 | |
|       INTEGER            ILAENV
 | |
|       EXTERNAL           ILAENV
 | |
| *     ..
 | |
| *     .. External Subroutines ..
 | |
|       EXTERNAL           SGTTS2, XERBLA
 | |
| *     ..
 | |
| *     .. Intrinsic Functions ..
 | |
|       INTRINSIC          MAX, MIN
 | |
| *     ..
 | |
| *     .. Executable Statements ..
 | |
| *
 | |
|       INFO = 0
 | |
|       NOTRAN = ( TRANS.EQ.'N' .OR. TRANS.EQ.'n' )
 | |
|       IF( .NOT.NOTRAN .AND. .NOT.( TRANS.EQ.'T' .OR. TRANS.EQ.
 | |
|      $    't' ) .AND. .NOT.( TRANS.EQ.'C' .OR. TRANS.EQ.'c' ) ) THEN
 | |
|          INFO = -1
 | |
|       ELSE IF( N.LT.0 ) THEN
 | |
|          INFO = -2
 | |
|       ELSE IF( NRHS.LT.0 ) THEN
 | |
|          INFO = -3
 | |
|       ELSE IF( LDB.LT.MAX( N, 1 ) ) THEN
 | |
|          INFO = -10
 | |
|       END IF
 | |
|       IF( INFO.NE.0 ) THEN
 | |
|          CALL XERBLA( 'SGTTRS', -INFO )
 | |
|          RETURN
 | |
|       END IF
 | |
| *
 | |
| *     Quick return if possible
 | |
| *
 | |
|       IF( N.EQ.0 .OR. NRHS.EQ.0 )
 | |
|      $   RETURN
 | |
| *
 | |
| *     Decode TRANS
 | |
| *
 | |
|       IF( NOTRAN ) THEN
 | |
|          ITRANS = 0
 | |
|       ELSE
 | |
|          ITRANS = 1
 | |
|       END IF
 | |
| *
 | |
| *     Determine the number of right-hand sides to solve at a time.
 | |
| *
 | |
|       IF( NRHS.EQ.1 ) THEN
 | |
|          NB = 1
 | |
|       ELSE
 | |
|          NB = MAX( 1, ILAENV( 1, 'SGTTRS', TRANS, N, NRHS, -1, -1 ) )
 | |
|       END IF
 | |
| *
 | |
|       IF( NB.GE.NRHS ) THEN
 | |
|          CALL SGTTS2( ITRANS, N, NRHS, DL, D, DU, DU2, IPIV, B, LDB )
 | |
|       ELSE
 | |
|          DO 10 J = 1, NRHS, NB
 | |
|             JB = MIN( NRHS-J+1, NB )
 | |
|             CALL SGTTS2( ITRANS, N, JB, DL, D, DU, DU2, IPIV, B( 1, J ),
 | |
|      $                   LDB )
 | |
|    10    CONTINUE
 | |
|       END IF
 | |
| *
 | |
| *     End of SGTTRS
 | |
| *
 | |
|       END
 |