LAPACK 3.3.0

strtrs.f

Go to the documentation of this file.
00001       SUBROUTINE STRTRS( UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB,
00002      $                   INFO )
00003 *
00004 *  -- LAPACK routine (version 3.2) --
00005 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00006 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00007 *     November 2006
00008 *
00009 *     .. Scalar Arguments ..
00010       CHARACTER          DIAG, TRANS, UPLO
00011       INTEGER            INFO, LDA, LDB, N, NRHS
00012 *     ..
00013 *     .. Array Arguments ..
00014       REAL               A( LDA, * ), B( LDB, * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  STRTRS solves a triangular system of the form
00021 *
00022 *     A * X = B  or  A**T * X = B,
00023 *
00024 *  where A is a triangular matrix of order N, and B is an N-by-NRHS
00025 *  matrix.  A check is made to verify that A is nonsingular.
00026 *
00027 *  Arguments
00028 *  =========
00029 *
00030 *  UPLO    (input) CHARACTER*1
00031 *          = 'U':  A is upper triangular;
00032 *          = 'L':  A is lower triangular.
00033 *
00034 *  TRANS   (input) CHARACTER*1
00035 *          Specifies the form of the system of equations:
00036 *          = 'N':  A * X = B  (No transpose)
00037 *          = 'T':  A**T * X = B  (Transpose)
00038 *          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
00039 *
00040 *  DIAG    (input) CHARACTER*1
00041 *          = 'N':  A is non-unit triangular;
00042 *          = 'U':  A is unit triangular.
00043 *
00044 *  N       (input) INTEGER
00045 *          The order of the matrix A.  N >= 0.
00046 *
00047 *  NRHS    (input) INTEGER
00048 *          The number of right hand sides, i.e., the number of columns
00049 *          of the matrix B.  NRHS >= 0.
00050 *
00051 *  A       (input) REAL array, dimension (LDA,N)
00052 *          The triangular matrix A.  If UPLO = 'U', the leading N-by-N
00053 *          upper triangular part of the array A contains the upper
00054 *          triangular matrix, and the strictly lower triangular part of
00055 *          A is not referenced.  If UPLO = 'L', the leading N-by-N lower
00056 *          triangular part of the array A contains the lower triangular
00057 *          matrix, and the strictly upper triangular part of A is not
00058 *          referenced.  If DIAG = 'U', the diagonal elements of A are
00059 *          also not referenced and are assumed to be 1.
00060 *
00061 *  LDA     (input) INTEGER
00062 *          The leading dimension of the array A.  LDA >= max(1,N).
00063 *
00064 *  B       (input/output) REAL array, dimension (LDB,NRHS)
00065 *          On entry, the right hand side matrix B.
00066 *          On exit, if INFO = 0, the solution matrix X.
00067 *
00068 *  LDB     (input) INTEGER
00069 *          The leading dimension of the array B.  LDB >= max(1,N).
00070 *
00071 *  INFO    (output) INTEGER
00072 *          = 0:  successful exit
00073 *          < 0: if INFO = -i, the i-th argument had an illegal value
00074 *          > 0: if INFO = i, the i-th diagonal element of A is zero,
00075 *               indicating that the matrix is singular and the solutions
00076 *               X have not been computed.
00077 *
00078 *  =====================================================================
00079 *
00080 *     .. Parameters ..
00081       REAL               ZERO, ONE
00082       PARAMETER          ( ZERO = 0.0E+0, ONE = 1.0E+0 )
00083 *     ..
00084 *     .. Local Scalars ..
00085       LOGICAL            NOUNIT
00086 *     ..
00087 *     .. External Functions ..
00088       LOGICAL            LSAME
00089       EXTERNAL           LSAME
00090 *     ..
00091 *     .. External Subroutines ..
00092       EXTERNAL           STRSM, XERBLA
00093 *     ..
00094 *     .. Intrinsic Functions ..
00095       INTRINSIC          MAX
00096 *     ..
00097 *     .. Executable Statements ..
00098 *
00099 *     Test the input parameters.
00100 *
00101       INFO = 0
00102       NOUNIT = LSAME( DIAG, 'N' )
00103       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00104          INFO = -1
00105       ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
00106      $         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
00107          INFO = -2
00108       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
00109          INFO = -3
00110       ELSE IF( N.LT.0 ) THEN
00111          INFO = -4
00112       ELSE IF( NRHS.LT.0 ) THEN
00113          INFO = -5
00114       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00115          INFO = -7
00116       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
00117          INFO = -9
00118       END IF
00119       IF( INFO.NE.0 ) THEN
00120          CALL XERBLA( 'STRTRS', -INFO )
00121          RETURN
00122       END IF
00123 *
00124 *     Quick return if possible
00125 *
00126       IF( N.EQ.0 )
00127      $   RETURN
00128 *
00129 *     Check for singularity.
00130 *
00131       IF( NOUNIT ) THEN
00132          DO 10 INFO = 1, N
00133             IF( A( INFO, INFO ).EQ.ZERO )
00134      $         RETURN
00135    10    CONTINUE
00136       END IF
00137       INFO = 0
00138 *
00139 *     Solve A * x = b  or  A' * x = b.
00140 *
00141       CALL STRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
00142      $            LDB )
00143 *
00144       RETURN
00145 *
00146 *     End of STRTRS
00147 *
00148       END
 All Files Functions