141 DOUBLE PRECISION FUNCTION dlantr( NORM, UPLO, DIAG, M, N, A, LDA,
150 CHARACTER diag, norm, uplo
154 DOUBLE PRECISION a( lda, * ), work( * )
160 DOUBLE PRECISION one, zero
161 parameter( one = 1.0d+0, zero = 0.0d+0 )
166 DOUBLE PRECISION scale, sum,
value
176 INTRINSIC abs, min, sqrt
180 IF( min( m, n ).EQ.0 )
THEN
182 ELSE IF(
lsame( norm,
'M' ) )
THEN
186 IF(
lsame( diag,
'U' ) )
THEN
188 IF(
lsame( uplo,
'U' ) )
THEN
190 DO 10 i = 1, min( m,
j-1 )
191 sum = abs( a( i,
j ) )
198 sum = abs( a( i,
j ) )
205 IF(
lsame( uplo,
'U' ) )
THEN
207 DO 50 i = 1, min( m,
j )
208 sum = abs( a( i,
j ) )
215 sum = abs( a( i,
j ) )
221 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
226 udiag =
lsame( diag,
'U' )
227 IF(
lsame( uplo,
'U' ) )
THEN
229 IF( ( udiag ) .AND. (
j.LE.m ) )
THEN
232 sum = sum + abs( a( i,
j ) )
236 DO 100 i = 1, min( m,
j )
237 sum = sum + abs( a( i,
j ) )
247 sum = sum + abs( a( i,
j ) )
252 sum = sum + abs( a( i,
j ) )
258 ELSE IF(
lsame( norm,
'I' ) )
THEN
262 IF(
lsame( uplo,
'U' ) )
THEN
263 IF(
lsame( diag,
'U' ) )
THEN
268 DO 160 i = 1, min( m,
j-1 )
269 work( i ) = work( i ) + abs( a( i,
j ) )
277 DO 190 i = 1, min( m,
j )
278 work( i ) = work( i ) + abs( a( i,
j ) )
283 IF(
lsame( diag,
'U' ) )
THEN
292 work( i ) = work( i ) + abs( a( i,
j ) )
301 work( i ) = work( i ) + abs( a( i,
j ) )
311 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
315 IF(
lsame( uplo,
'U' ) )
THEN
316 IF(
lsame( diag,
'U' ) )
THEN
320 CALL
dlassq( min( m,
j-1 ), a( 1,
j ), 1, scale, sum )
326 CALL
dlassq( min( m,
j ), a( 1,
j ), 1, scale, sum )
330 IF(
lsame( diag,
'U' ) )
THEN
334 CALL
dlassq( m-
j, a( min( m,
j+1 ),
j ), 1, scale,
341 CALL
dlassq( m-
j+1, a(
j,
j ), 1, scale, sum )
345 value = scale*sqrt( sum )