LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ 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*
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
lsame
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: