142 REAL FUNCTION clantr( NORM, UPLO, DIAG, M, N, A, LDA,
151 CHARACTER diag, norm, uplo
163 parameter( one = 1.0e+0, zero = 0.0e+0 )
168 REAL scale, sum,
value
178 INTRINSIC abs, min, sqrt
182 IF( min( m, n ).EQ.0 )
THEN
184 ELSE IF(
lsame( norm,
'M' ) )
THEN
188 IF(
lsame( diag,
'U' ) )
THEN
190 IF(
lsame( uplo,
'U' ) )
THEN
192 DO 10 i = 1, min( m,
j-1 )
193 sum = abs( a( i,
j ) )
200 sum = abs( a( i,
j ) )
207 IF(
lsame( uplo,
'U' ) )
THEN
209 DO 50 i = 1, min( m,
j )
210 sum = abs( a( i,
j ) )
217 sum = abs( a( i,
j ) )
223 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
228 udiag =
lsame( diag,
'U' )
229 IF(
lsame( uplo,
'U' ) )
THEN
231 IF( ( udiag ) .AND. (
j.LE.m ) )
THEN
234 sum = sum + abs( a( i,
j ) )
238 DO 100 i = 1, min( m,
j )
239 sum = sum + abs( a( i,
j ) )
249 sum = sum + abs( a( i,
j ) )
254 sum = sum + abs( a( i,
j ) )
260 ELSE IF(
lsame( norm,
'I' ) )
THEN
264 IF(
lsame( uplo,
'U' ) )
THEN
265 IF(
lsame( diag,
'U' ) )
THEN
270 DO 160 i = 1, min( m,
j-1 )
271 work( i ) = work( i ) + abs( a( i,
j ) )
279 DO 190 i = 1, min( m,
j )
280 work( i ) = work( i ) + abs( a( i,
j ) )
285 IF(
lsame( diag,
'U' ) )
THEN
294 work( i ) = work( i ) + abs( a( i,
j ) )
303 work( i ) = work( i ) + abs( a( i,
j ) )
313 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
317 IF(
lsame( uplo,
'U' ) )
THEN
318 IF(
lsame( diag,
'U' ) )
THEN
322 CALL
classq( min( m,
j-1 ), a( 1,
j ), 1, scale, sum )
328 CALL
classq( min( m,
j ), a( 1,
j ), 1, scale, sum )
332 IF(
lsame( diag,
'U' ) )
THEN
336 CALL
classq( m-
j, a( min( m,
j+1 ),
j ), 1, scale,
343 CALL
classq( m-
j+1, a(
j,
j ), 1, scale, sum )
347 value = scale*sqrt( sum )