001:       SUBROUTINE DTPTRS( UPLO, TRANS, DIAG, N, NRHS, AP, B, LDB, INFO )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       CHARACTER          DIAG, TRANS, UPLO
010:       INTEGER            INFO, LDB, N, NRHS
011: *     ..
012: *     .. Array Arguments ..
013:       DOUBLE PRECISION   AP( * ), B( LDB, * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DTPTRS solves a triangular system of the form
020: *
021: *     A * X = B  or  A**T * X = B,
022: *
023: *  where A is a triangular matrix of order N stored in packed format,
024: *  and B is an N-by-NRHS matrix.  A check is made to verify that A is
025: *  nonsingular.
026: *
027: *  Arguments
028: *  =========
029: *
030: *  UPLO    (input) CHARACTER*1
031: *          = 'U':  A is upper triangular;
032: *          = 'L':  A is lower triangular.
033: *
034: *  TRANS   (input) CHARACTER*1
035: *          Specifies the form of the system of equations:
036: *          = 'N':  A * X = B  (No transpose)
037: *          = 'T':  A**T * X = B  (Transpose)
038: *          = 'C':  A**H * X = B  (Conjugate transpose = Transpose)
039: *
040: *  DIAG    (input) CHARACTER*1
041: *          = 'N':  A is non-unit triangular;
042: *          = 'U':  A is unit triangular.
043: *
044: *  N       (input) INTEGER
045: *          The order of the matrix A.  N >= 0.
046: *
047: *  NRHS    (input) INTEGER
048: *          The number of right hand sides, i.e., the number of columns
049: *          of the matrix B.  NRHS >= 0.
050: *
051: *  AP      (input) DOUBLE PRECISION array, dimension (N*(N+1)/2)
052: *          The upper or lower triangular matrix A, packed columnwise in
053: *          a linear array.  The j-th column of A is stored in the array
054: *          AP as follows:
055: *          if UPLO = 'U', AP(i + (j-1)*j/2) = A(i,j) for 1<=i<=j;
056: *          if UPLO = 'L', AP(i + (j-1)*(2*n-j)/2) = A(i,j) for j<=i<=n.
057: *
058: *  B       (input/output) DOUBLE PRECISION array, dimension (LDB,NRHS)
059: *          On entry, the right hand side matrix B.
060: *          On exit, if INFO = 0, the solution matrix X.
061: *
062: *  LDB     (input) INTEGER
063: *          The leading dimension of the array B.  LDB >= max(1,N).
064: *
065: *  INFO    (output) INTEGER
066: *          = 0:  successful exit
067: *          < 0:  if INFO = -i, the i-th argument had an illegal value
068: *          > 0:  if INFO = i, the i-th diagonal element of A is zero,
069: *                indicating that the matrix is singular and the
070: *                solutions X have not been computed.
071: *
072: *  =====================================================================
073: *
074: *     .. Parameters ..
075:       DOUBLE PRECISION   ZERO
076:       PARAMETER          ( ZERO = 0.0D+0 )
077: *     ..
078: *     .. Local Scalars ..
079:       LOGICAL            NOUNIT, UPPER
080:       INTEGER            J, JC
081: *     ..
082: *     .. External Functions ..
083:       LOGICAL            LSAME
084:       EXTERNAL           LSAME
085: *     ..
086: *     .. External Subroutines ..
087:       EXTERNAL           DTPSV, XERBLA
088: *     ..
089: *     .. Intrinsic Functions ..
090:       INTRINSIC          MAX
091: *     ..
092: *     .. Executable Statements ..
093: *
094: *     Test the input parameters.
095: *
096:       INFO = 0
097:       UPPER = LSAME( UPLO, 'U' )
098:       NOUNIT = LSAME( DIAG, 'N' )
099:       IF( .NOT.UPPER .AND. .NOT.LSAME( UPLO, 'L' ) ) THEN
100:          INFO = -1
101:       ELSE IF( .NOT.LSAME( TRANS, 'N' ) .AND. .NOT.
102:      $         LSAME( TRANS, 'T' ) .AND. .NOT.LSAME( TRANS, 'C' ) ) THEN
103:          INFO = -2
104:       ELSE IF( .NOT.NOUNIT .AND. .NOT.LSAME( DIAG, 'U' ) ) THEN
105:          INFO = -3
106:       ELSE IF( N.LT.0 ) THEN
107:          INFO = -4
108:       ELSE IF( NRHS.LT.0 ) THEN
109:          INFO = -5
110:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
111:          INFO = -8
112:       END IF
113:       IF( INFO.NE.0 ) THEN
114:          CALL XERBLA( 'DTPTRS', -INFO )
115:          RETURN
116:       END IF
117: *
118: *     Quick return if possible
119: *
120:       IF( N.EQ.0 )
121:      $   RETURN
122: *
123: *     Check for singularity.
124: *
125:       IF( NOUNIT ) THEN
126:          IF( UPPER ) THEN
127:             JC = 1
128:             DO 10 INFO = 1, N
129:                IF( AP( JC+INFO-1 ).EQ.ZERO )
130:      $            RETURN
131:                JC = JC + INFO
132:    10       CONTINUE
133:          ELSE
134:             JC = 1
135:             DO 20 INFO = 1, N
136:                IF( AP( JC ).EQ.ZERO )
137:      $            RETURN
138:                JC = JC + N - INFO + 1
139:    20       CONTINUE
140:          END IF
141:       END IF
142:       INFO = 0
143: *
144: *     Solve A * x = b  or  A' * x = b.
145: *
146:       DO 30 J = 1, NRHS
147:          CALL DTPSV( UPLO, TRANS, DIAG, N, AP, B( 1, J ), 1 )
148:    30 CONTINUE
149: *
150:       RETURN
151: *
152: *     End of DTPTRS
153: *
154:       END
155: