145 SUBROUTINE stpsv(UPLO,TRANS,DIAG,N,AP,X,INCX)
154 CHARACTER diag,trans,uplo
164 parameter(zero=0.0e+0)
168 INTEGER i,info,ix,
j,jx,k,kk,kx
182 IF (.NOT.
lsame(uplo,
'U') .AND. .NOT.
lsame(uplo,
'L'))
THEN
184 ELSE IF (.NOT.
lsame(trans,
'N') .AND. .NOT.
lsame(trans,
'T') .AND.
185 + .NOT.
lsame(trans,
'C'))
THEN
187 ELSE IF (.NOT.
lsame(diag,
'U') .AND. .NOT.
lsame(diag,
'N'))
THEN
189 ELSE IF (n.LT.0)
THEN
191 ELSE IF (incx.EQ.0)
THEN
195 CALL
xerbla(
'STPSV ',info)
203 nounit =
lsame(diag,
'N')
210 ELSE IF (incx.NE.1)
THEN
217 IF (
lsame(trans,
'N'))
THEN
221 IF (
lsame(uplo,
'U'))
THEN
225 IF (
x(
j).NE.zero)
THEN
226 IF (nounit)
x(
j) =
x(
j)/ap(kk)
230 x(i) =
x(i) - temp*ap(k)
239 IF (
x(jx).NE.zero)
THEN
240 IF (nounit)
x(jx) =
x(jx)/ap(kk)
243 DO 30 k = kk - 1,kk -
j + 1,-1
245 x(ix) =
x(ix) - temp*ap(k)
256 IF (
x(
j).NE.zero)
THEN
257 IF (nounit)
x(
j) =
x(
j)/ap(kk)
261 x(i) =
x(i) - temp*ap(k)
270 IF (
x(jx).NE.zero)
THEN
271 IF (nounit)
x(jx) =
x(jx)/ap(kk)
274 DO 70 k = kk + 1,kk + n -
j
276 x(ix) =
x(ix) - temp*ap(k)
288 IF (
lsame(uplo,
'U'))
THEN
295 temp = temp - ap(k)*
x(i)
298 IF (nounit) temp = temp/ap(kk+
j-1)
307 DO 110 k = kk,kk +
j - 2
308 temp = temp - ap(k)*
x(ix)
311 IF (nounit) temp = temp/ap(kk+
j-1)
323 DO 130 i = n,
j + 1,-1
324 temp = temp - ap(k)*
x(i)
327 IF (nounit) temp = temp/ap(kk-n+
j)
337 DO 150 k = kk,kk - (n- (
j+1)),-1
338 temp = temp - ap(k)*
x(ix)
341 IF (nounit) temp = temp/ap(kk-n+
j)
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine stpsv(UPLO, TRANS, DIAG, N, AP, X, INCX)
STPSV
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j