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

STPMV

Purpose: 
 STPMV  performs one of the matrix-vector operations

    x := A*x,   or   x := A**T*x,

 where x is an n element vector and  A is an n by n unit, or non-unit,
 upper or lower triangular matrix, supplied in packed form.
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 operation to be performed as
           follows:

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

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

              TRANS = 'C' or 'c'   x := A**T*x.
[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 vector x. On exit, X is overwritten with the
           tranformed 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.
  The vector and matrix arguments are not referenced when N = 0, or M = 0

  -- 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 144 of file stpmv.f.

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