125 DOUBLE PRECISION FUNCTION dlantp( NORM, UPLO, DIAG, N, AP, WORK )
133 CHARACTER diag, norm, uplo
137 DOUBLE PRECISION ap( * ), work( * )
143 DOUBLE PRECISION one, zero
144 parameter( one = 1.0d+0, zero = 0.0d+0 )
149 DOUBLE PRECISION 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
dlassq(
j-1, ap( k ), 1, scale, sum )
324 CALL
dlassq(
j, ap( k ), 1, scale, sum )
329 IF(
lsame( diag,
'U' ) )
THEN
334 CALL
dlassq( n-
j, ap( k ), 1, scale, sum )
342 CALL
dlassq( n-
j+1, ap( k ), 1, scale, sum )
347 value = scale*sqrt( sum )
input scalars passed by value
logical function lsame(CA, CB)
LSAME
subroutine dlassq(N, X, INCX, SCALE, SUMSQ)
DLASSQ updates a sum of squares represented in scaled form.
double precision function dlantp(NORM, UPLO, DIAG, N, AP, WORK)
DLANTP 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 disnan(DIN)
DISNAN tests input for NaN.