LAPACK  3.10.0
LAPACK: Linear Algebra PACKage

◆ dtpsv()

subroutine dtpsv ( character  UPLO,
character  TRANS,
character  DIAG,
integer  N,
double precision, dimension(*)  AP,
double precision, dimension(*)  X,
integer  INCX 
)

DTPSV

Purpose:
 DTPSV  solves one of the systems of equations

    A*x = b,   or   A**T*x = b,

 where b and x are n element vectors and A is an n by n unit, or
 non-unit, upper or lower triangular matrix, supplied in packed form.

 No test for singularity or near-singularity is included in this
 routine. Such tests must be performed before calling this routine.
Parameters
[in]UPLO
          UPLO is CHARACTER*1
           On entry, UPLO specifies whether the matrix is an upper or
           lower triangular matrix as follows:

              UPLO = 'U' or 'u'   A is an upper triangular matrix.

              UPLO = 'L' or 'l'   A is a lower triangular matrix.
[in]TRANS
          TRANS is CHARACTER*1
           On entry, TRANS specifies the equations to be solved as
           follows:

              TRANS = 'N' or 'n'   A*x = b.

              TRANS = 'T' or 't'   A**T*x = b.

              TRANS = 'C' or 'c'   A**T*x = b.
[in]DIAG
          DIAG is CHARACTER*1
           On entry, DIAG specifies whether or not A is unit
           triangular as follows:

              DIAG = 'U' or 'u'   A is assumed to be unit triangular.

              DIAG = 'N' or 'n'   A is not assumed to be unit
                                  triangular.
[in]N
          N is INTEGER
           On entry, N specifies the order of the matrix A.
           N must be at least zero.
[in]AP
          AP is DOUBLE PRECISION array, dimension at least
           ( ( n*( n + 1 ) )/2 ).
           Before entry with  UPLO = 'U' or 'u', the array AP must
           contain the upper triangular matrix packed sequentially,
           column by column, so that AP( 1 ) contains a( 1, 1 ),
           AP( 2 ) and AP( 3 ) contain a( 1, 2 ) and a( 2, 2 )
           respectively, and so on.
           Before entry with UPLO = 'L' or 'l', the array AP must
           contain the lower triangular matrix packed sequentially,
           column by column, so that AP( 1 ) contains a( 1, 1 ),
           AP( 2 ) and AP( 3 ) contain a( 2, 1 ) and a( 3, 1 )
           respectively, and so on.
           Note that when  DIAG = 'U' or 'u', the diagonal elements of
           A are not referenced, but are assumed to be unity.
[in,out]X
          X is DOUBLE PRECISION array, dimension at least
           ( 1 + ( n - 1 )*abs( INCX ) ).
           Before entry, the incremented array X must contain the n
           element right-hand side vector b. On exit, X is overwritten
           with the solution vector x.
[in]INCX
          INCX is INTEGER
           On entry, INCX specifies the increment for the elements of
           X. INCX must not be zero.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Further Details:
  Level 2 Blas routine.

  -- Written on 22-October-1986.
     Jack Dongarra, Argonne National Lab.
     Jeremy Du Croz, Nag Central Office.
     Sven Hammarling, Nag Central Office.
     Richard Hanson, Sandia National Labs.

Definition at line 143 of file dtpsv.f.

144 *
145 * -- Reference BLAS level2 routine --
146 * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
147 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148 *
149 * .. Scalar Arguments ..
150  INTEGER INCX,N
151  CHARACTER DIAG,TRANS,UPLO
152 * ..
153 * .. Array Arguments ..
154  DOUBLE PRECISION AP(*),X(*)
155 * ..
156 *
157 * =====================================================================
158 *
159 * .. Parameters ..
160  DOUBLE PRECISION ZERO
161  parameter(zero=0.0d+0)
162 * ..
163 * .. Local Scalars ..
164  DOUBLE PRECISION TEMP
165  INTEGER I,INFO,IX,J,JX,K,KK,KX
166  LOGICAL NOUNIT
167 * ..
168 * .. External Functions ..
169  LOGICAL LSAME
170  EXTERNAL lsame
171 * ..
172 * .. External Subroutines ..
173  EXTERNAL xerbla
174 * ..
175 *
176 * Test the input parameters.
177 *
178  info = 0
179  IF (.NOT.lsame(uplo,'U') .AND. .NOT.lsame(uplo,'L')) THEN
180  info = 1
181  ELSE IF (.NOT.lsame(trans,'N') .AND. .NOT.lsame(trans,'T') .AND.
182  + .NOT.lsame(trans,'C')) THEN
183  info = 2
184  ELSE IF (.NOT.lsame(diag,'U') .AND. .NOT.lsame(diag,'N')) THEN
185  info = 3
186  ELSE IF (n.LT.0) THEN
187  info = 4
188  ELSE IF (incx.EQ.0) THEN
189  info = 7
190  END IF
191  IF (info.NE.0) THEN
192  CALL xerbla('DTPSV ',info)
193  RETURN
194  END IF
195 *
196 * Quick return if possible.
197 *
198  IF (n.EQ.0) RETURN
199 *
200  nounit = lsame(diag,'N')
201 *
202 * Set up the start point in X if the increment is not unity. This
203 * will be ( N - 1 )*INCX too small for descending loops.
204 *
205  IF (incx.LE.0) THEN
206  kx = 1 - (n-1)*incx
207  ELSE IF (incx.NE.1) THEN
208  kx = 1
209  END IF
210 *
211 * Start the operations. In this version the elements of AP are
212 * accessed sequentially with one pass through AP.
213 *
214  IF (lsame(trans,'N')) THEN
215 *
216 * Form x := inv( A )*x.
217 *
218  IF (lsame(uplo,'U')) THEN
219  kk = (n* (n+1))/2
220  IF (incx.EQ.1) THEN
221  DO 20 j = n,1,-1
222  IF (x(j).NE.zero) THEN
223  IF (nounit) x(j) = x(j)/ap(kk)
224  temp = x(j)
225  k = kk - 1
226  DO 10 i = j - 1,1,-1
227  x(i) = x(i) - temp*ap(k)
228  k = k - 1
229  10 CONTINUE
230  END IF
231  kk = kk - j
232  20 CONTINUE
233  ELSE
234  jx = kx + (n-1)*incx
235  DO 40 j = n,1,-1
236  IF (x(jx).NE.zero) THEN
237  IF (nounit) x(jx) = x(jx)/ap(kk)
238  temp = x(jx)
239  ix = jx
240  DO 30 k = kk - 1,kk - j + 1,-1
241  ix = ix - incx
242  x(ix) = x(ix) - temp*ap(k)
243  30 CONTINUE
244  END IF
245  jx = jx - incx
246  kk = kk - j
247  40 CONTINUE
248  END IF
249  ELSE
250  kk = 1
251  IF (incx.EQ.1) THEN
252  DO 60 j = 1,n
253  IF (x(j).NE.zero) THEN
254  IF (nounit) x(j) = x(j)/ap(kk)
255  temp = x(j)
256  k = kk + 1
257  DO 50 i = j + 1,n
258  x(i) = x(i) - temp*ap(k)
259  k = k + 1
260  50 CONTINUE
261  END IF
262  kk = kk + (n-j+1)
263  60 CONTINUE
264  ELSE
265  jx = kx
266  DO 80 j = 1,n
267  IF (x(jx).NE.zero) THEN
268  IF (nounit) x(jx) = x(jx)/ap(kk)
269  temp = x(jx)
270  ix = jx
271  DO 70 k = kk + 1,kk + n - j
272  ix = ix + incx
273  x(ix) = x(ix) - temp*ap(k)
274  70 CONTINUE
275  END IF
276  jx = jx + incx
277  kk = kk + (n-j+1)
278  80 CONTINUE
279  END IF
280  END IF
281  ELSE
282 *
283 * Form x := inv( A**T )*x.
284 *
285  IF (lsame(uplo,'U')) THEN
286  kk = 1
287  IF (incx.EQ.1) THEN
288  DO 100 j = 1,n
289  temp = x(j)
290  k = kk
291  DO 90 i = 1,j - 1
292  temp = temp - ap(k)*x(i)
293  k = k + 1
294  90 CONTINUE
295  IF (nounit) temp = temp/ap(kk+j-1)
296  x(j) = temp
297  kk = kk + j
298  100 CONTINUE
299  ELSE
300  jx = kx
301  DO 120 j = 1,n
302  temp = x(jx)
303  ix = kx
304  DO 110 k = kk,kk + j - 2
305  temp = temp - ap(k)*x(ix)
306  ix = ix + incx
307  110 CONTINUE
308  IF (nounit) temp = temp/ap(kk+j-1)
309  x(jx) = temp
310  jx = jx + incx
311  kk = kk + j
312  120 CONTINUE
313  END IF
314  ELSE
315  kk = (n* (n+1))/2
316  IF (incx.EQ.1) THEN
317  DO 140 j = n,1,-1
318  temp = x(j)
319  k = kk
320  DO 130 i = n,j + 1,-1
321  temp = temp - ap(k)*x(i)
322  k = k - 1
323  130 CONTINUE
324  IF (nounit) temp = temp/ap(kk-n+j)
325  x(j) = temp
326  kk = kk - (n-j+1)
327  140 CONTINUE
328  ELSE
329  kx = kx + (n-1)*incx
330  jx = kx
331  DO 160 j = n,1,-1
332  temp = x(jx)
333  ix = kx
334  DO 150 k = kk,kk - (n- (j+1)),-1
335  temp = temp - ap(k)*x(ix)
336  ix = ix - incx
337  150 CONTINUE
338  IF (nounit) temp = temp/ap(kk-n+j)
339  x(jx) = temp
340  jx = jx - incx
341  kk = kk - (n-j+1)
342  160 CONTINUE
343  END IF
344  END IF
345  END IF
346 *
347  RETURN
348 *
349 * End of DTPSV
350 *
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
logical function lsame(CA, CB)
LSAME
Definition: lsame.f:53
Here is the call graph for this function:
Here is the caller graph for this function: