LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine stpsv ( character  UPLO,
character  TRANS,
character  DIAG,
integer  N,
real, dimension(*)  AP,
real, dimension(*)  X,
integer  INCX 
)

STPSV

Purpose: 
 STPSV  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 REAL array of 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 REAL array of 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.
Date
November 2011
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 146 of file stpsv.f.

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

Here is the call graph for this function:

Here is the caller graph for this function: