126 REAL FUNCTION clantp( NORM, UPLO, DIAG, N, AP, WORK )
134 CHARACTER diag, norm, uplo
146 parameter( one = 1.0e+0, zero = 0.0e+0 )
151 REAL scale, sum,
value
167 ELSE IF(
lsame( norm,
'M' ) )
THEN
172 IF(
lsame( diag,
'U' ) )
THEN
174 IF(
lsame( uplo,
'U' ) )
THEN
176 DO 10 i = k, k +
j - 2
184 DO 30 i = k + 1, k + n -
j
193 IF(
lsame( uplo,
'U' ) )
THEN
195 DO 50 i = k, k +
j - 1
203 DO 70 i = k, k + n -
j
211 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
217 udiag =
lsame( diag,
'U' )
218 IF(
lsame( uplo,
'U' ) )
THEN
222 DO 90 i = k, k +
j - 2
223 sum = sum + abs( ap( i ) )
227 DO 100 i = k, k +
j - 1
228 sum = sum + abs( ap( i ) )
238 DO 120 i = k + 1, k + n -
j
239 sum = sum + abs( ap( i ) )
243 DO 130 i = k, k + n -
j
244 sum = sum + abs( ap( i ) )
251 ELSE IF(
lsame( norm,
'I' ) )
THEN
256 IF(
lsame( uplo,
'U' ) )
THEN
257 IF(
lsame( diag,
'U' ) )
THEN
263 work( i ) = work( i ) + abs( ap( k ) )
274 work( i ) = work( i ) + abs( ap( k ) )
280 IF(
lsame( diag,
'U' ) )
THEN
287 work( i ) = work( i ) + abs( ap( k ) )
297 work( i ) = work( i ) + abs( ap( k ) )
308 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
312 IF(
lsame( uplo,
'U' ) )
THEN
313 IF(
lsame( diag,
'U' ) )
THEN
318 CALL
classq(
j-1, ap( k ), 1, scale, sum )
326 CALL
classq(
j, ap( k ), 1, scale, sum )
331 IF(
lsame( diag,
'U' ) )
THEN
336 CALL
classq( n-
j, ap( k ), 1, scale, sum )
344 CALL
classq( n-
j+1, ap( k ), 1, scale, sum )
349 value = scale*sqrt( sum )
REAL function clantp(NORM, UPLO, DIAG, N, AP, WORK)
CLANTP 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.
LOGICAL function lsame(CA, CB)
LSAME
input scalars passed by value
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j