125 REAL FUNCTION slantp( NORM, UPLO, DIAG, N, AP, WORK )
133 CHARACTER diag, norm, uplo
137 REAL ap( * ), work( * )
144 parameter( one = 1.0e+0, zero = 0.0e+0 )
149 REAL scale, sum,
value
165 ELSE IF(
lsame( norm,
'M' ) )
THEN
170 IF(
lsame( diag,
'U' ) )
THEN
172 IF(
lsame( uplo,
'U' ) )
THEN
174 DO 10 i = k, k +
j - 2
182 DO 30 i = k + 1, k + n -
j
191 IF(
lsame( uplo,
'U' ) )
THEN
193 DO 50 i = k, k +
j - 1
201 DO 70 i = k, k + n -
j
209 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
215 udiag =
lsame( diag,
'U' )
216 IF(
lsame( uplo,
'U' ) )
THEN
220 DO 90 i = k, k +
j - 2
221 sum = sum + abs( ap( i ) )
225 DO 100 i = k, k +
j - 1
226 sum = sum + abs( ap( i ) )
236 DO 120 i = k + 1, k + n -
j
237 sum = sum + abs( ap( i ) )
241 DO 130 i = k, k + n -
j
242 sum = sum + abs( ap( i ) )
249 ELSE IF(
lsame( norm,
'I' ) )
THEN
254 IF(
lsame( uplo,
'U' ) )
THEN
255 IF(
lsame( diag,
'U' ) )
THEN
261 work( i ) = work( i ) + abs( ap( k ) )
272 work( i ) = work( i ) + abs( ap( k ) )
278 IF(
lsame( diag,
'U' ) )
THEN
285 work( i ) = work( i ) + abs( ap( k ) )
295 work( i ) = work( i ) + abs( ap( k ) )
306 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
310 IF(
lsame( uplo,
'U' ) )
THEN
311 IF(
lsame( diag,
'U' ) )
THEN
316 CALL
slassq(
j-1, ap( k ), 1, scale, sum )
324 CALL
slassq(
j, ap( k ), 1, scale, sum )
329 IF(
lsame( diag,
'U' ) )
THEN
334 CALL
slassq( n-
j, ap( k ), 1, scale, sum )
342 CALL
slassq( n-
j+1, ap( k ), 1, scale, sum )
347 value = scale*sqrt( sum )
subroutine slassq(N, X, INCX, SCALE, SUMSQ)
SLASSQ updates a sum of squares represented in scaled form.
input scalars passed by value
logical function lsame(CA, CB)
LSAME
real function slantp(NORM, UPLO, DIAG, N, AP, WORK)
SLANTP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a triangular matrix supplied in packed form.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
logical function sisnan(SIN)
SISNAN tests input for NaN.