126 DOUBLE PRECISION FUNCTION zlantp( NORM, UPLO, DIAG, N, AP, WORK )
134 CHARACTER diag, norm, uplo
138 DOUBLE PRECISION work( * )
145 DOUBLE PRECISION one, zero
146 parameter( one = 1.0d+0, zero = 0.0d+0 )
151 DOUBLE PRECISION 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
zlassq(
j-1, ap( k ), 1, scale, sum )
326 CALL
zlassq(
j, ap( k ), 1, scale, sum )
331 IF(
lsame( diag,
'U' ) )
THEN
336 CALL
zlassq( n-
j, ap( k ), 1, scale, sum )
344 CALL
zlassq( n-
j+1, ap( k ), 1, scale, sum )
349 value = scale*sqrt( sum )
subroutine zlassq(N, X, INCX, SCALE, SUMSQ)
ZLASSQ updates a sum of squares represented in scaled form.
input scalars passed by value
double precision function zlantp(NORM, UPLO, DIAG, N, AP, WORK)
ZLANTP 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
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
logical function disnan(DIN)
DISNAN tests input for NaN.