116 DOUBLE PRECISION FUNCTION zlanhp( NORM, UPLO, N, AP, WORK )
127 DOUBLE PRECISION work( * )
134 DOUBLE PRECISION one, zero
135 parameter( one = 1.0d+0, zero = 0.0d+0 )
139 DOUBLE PRECISION absa, scale, sum, value
149 INTRINSIC abs, dble, sqrt
155 ELSE IF(
lsame( norm,
'M' ) )
THEN
160 IF(
lsame( uplo,
'U' ) )
THEN
163 DO 10 i = k + 1, k + j - 1
165 IF(
VALUE .LT. sum .OR.
disnan( sum ) )
VALUE = sum
168 sum = abs( dble( ap( k ) ) )
169 IF(
VALUE .LT. sum .OR.
disnan( sum ) )
VALUE = sum
174 sum = abs( dble( ap( k ) ) )
175 IF(
VALUE .LT. sum .OR.
disnan( sum ) )
VALUE = sum
176 DO 30 i = k + 1, k + n - j
178 IF(
VALUE .LT. sum .OR.
disnan( sum ) )
VALUE = sum
183 ELSE IF( (
lsame( norm,
'I' ) ) .OR. (
lsame( norm,
'O' ) ) .OR.
184 $ ( norm.EQ.
'1' ) )
THEN
190 IF(
lsame( uplo,
'U' ) )
THEN
194 absa = abs( ap( k ) )
196 work( i ) = work( i ) + absa
199 work( j ) = sum + abs( dble( ap( k ) ) )
204 IF(
VALUE .LT. sum .OR.
disnan( sum ) )
VALUE = sum
211 sum = work( j ) + abs( dble( ap( k ) ) )
214 absa = abs( ap( k ) )
216 work( i ) = work( i ) + absa
219 IF(
VALUE .LT. sum .OR.
disnan( sum ) )
VALUE = sum
222 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
229 IF(
lsame( uplo,
'U' ) )
THEN
231 CALL zlassq( j-1, ap( k ), 1, scale, sum )
236 CALL zlassq( n-j, ap( k ), 1, scale, sum )
243 IF( dble( ap( k ) ).NE.zero )
THEN
244 absa = abs( dble( ap( k ) ) )
245 IF( scale.LT.absa )
THEN
246 sum = one + sum*( scale / absa )**2
249 sum = sum + ( absa / scale )**2
252 IF(
lsame( uplo,
'U' ) )
THEN
258 VALUE = scale*sqrt( sum )
logical function disnan(din)
DISNAN tests input for NaN.
double precision function zlanhp(norm, uplo, n, ap, work)
ZLANHP returns the value of the 1-norm, or the Frobenius norm, or the infinity norm,...
subroutine zlassq(n, x, incx, scale, sumsq)
ZLASSQ updates a sum of squares represented in scaled form.
logical function lsame(ca, cb)
LSAME