LAPACK 3.3.1 Linear Algebra PACKage

# ctrtrs.f

Go to the documentation of this file.
```00001       SUBROUTINE CTRTRS( 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       COMPLEX            A( LDA, * ), B( LDB, * )
00015 *     ..
00016 *
00017 *  Purpose
00018 *  =======
00019 *
00020 *  CTRTRS solves a triangular system of the form
00021 *
00022 *     A * X = B,  A**T * X = B,  or  A**H * 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)
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) COMPLEX 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) COMPLEX 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       COMPLEX            ZERO, ONE
00082       PARAMETER          ( ZERO = ( 0.0E+0, 0.0E+0 ),
00083      \$                   ONE = ( 1.0E+0, 0.0E+0 ) )
00084 *     ..
00085 *     .. Local Scalars ..
00086       LOGICAL            NOUNIT
00087 *     ..
00088 *     .. External Functions ..
00089       LOGICAL            LSAME
00090       EXTERNAL           LSAME
00091 *     ..
00092 *     .. External Subroutines ..
00093       EXTERNAL           CTRSM, XERBLA
00094 *     ..
00095 *     .. Intrinsic Functions ..
00096       INTRINSIC          MAX
00097 *     ..
00098 *     .. Executable Statements ..
00099 *
00100 *     Test the input parameters.
00101 *
00102       INFO = 0
00103       NOUNIT = LSAME( DIAG, 'N' )
00104       IF( .NOT.LSAME( UPLO, 'U' ) .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
00105          INFO = -1
00106       ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
00107      \$         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
00108          INFO = -2
00109       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
00110          INFO = -3
00111       ELSE IF( N.LT.0 ) THEN
00112          INFO = -4
00113       ELSE IF( NRHS.LT.0 ) THEN
00114          INFO = -5
00115       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
00116          INFO = -7
00117       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
00118          INFO = -9
00119       END IF
00120       IF( INFO.NE.0 ) THEN
00121          CALL XERBLA( 'CTRTRS', -INFO )
00122          RETURN
00123       END IF
00124 *
00125 *     Quick return if possible
00126 *
00127       IF( N.EQ.0 )
00128      \$   RETURN
00129 *
00130 *     Check for singularity.
00131 *
00132       IF( NOUNIT ) THEN
00133          DO 10 INFO = 1, N
00134             IF( A( INFO, INFO ).EQ.ZERO )
00135      \$         RETURN
00136    10    CONTINUE
00137       END IF
00138       INFO = 0
00139 *
00140 *     Solve A * x = b,  A**T * x = b,  or  A**H * x = b.
00141 *
00142       CALL CTRSM( 'Left', UPLO, TRANS, DIAG, N, NRHS, ONE, A, LDA, B,
00143      \$            LDB )
00144 *
00145       RETURN
00146 *
00147 *     End of CTRTRS
00148 *
00149       END
```