210 DOUBLE PRECISION FUNCTION dlansf( NORM, TRANSR, UPLO, N, A, WORK )
218 CHARACTER NORM, TRANSR, UPLO
222 DOUBLE PRECISION A( 0: * ), WORK( 0: * )
228 DOUBLE PRECISION ONE, ZERO
229 parameter ( one = 1.0d+0, zero = 0.0d+0 )
232 INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA
233 DOUBLE PRECISION SCALE, S,
VALUE, AA, TEMP
236 LOGICAL LSAME, DISNAN
237 EXTERNAL lsame, disnan
243 INTRINSIC abs, max, sqrt
250 ELSE IF( n.EQ.1 )
THEN
258 IF( mod( n, 2 ).EQ.0 )
264 IF( lsame( transr,
'T' ) )
270 IF( lsame( uplo,
'U' ) )
289 IF( lsame( norm,
'M' ) )
THEN
301 temp = abs( a( i+j*lda ) )
302 IF(
VALUE .LT. temp .OR. disnan( temp ) )
310 temp = abs( a( i+j*lda ) )
311 IF(
VALUE .LT. temp .OR. disnan( temp ) )
322 temp = abs( a( i+j*lda ) )
323 IF(
VALUE .LT. temp .OR. disnan( temp ) )
331 temp = abs( a( i+j*lda ) )
332 IF(
VALUE .LT. temp .OR. disnan( temp ) )
338 ELSE IF( ( lsame( norm,
'I' ) ) .OR. ( lsame( norm,
'O' ) ) .OR.
339 $ ( norm.EQ.
'1' ) )
THEN
354 aa = abs( a( i+j*lda ) )
357 work( i ) = work( i ) + aa
359 aa = abs( a( i+j*lda ) )
365 aa = abs( a( i+j*lda ) )
367 work( j ) = work( j ) + aa
371 aa = abs( a( i+j*lda ) )
374 work( l ) = work( l ) + aa
376 work( j ) = work( j ) + s
382 IF(
VALUE .LT. temp .OR. disnan( temp ) )
395 aa = abs( a( i+j*lda ) )
398 work( i+k ) = work( i+k ) + aa
401 aa = abs( a( i+j*lda ) )
404 work( i+k ) = work( i+k ) + s
408 aa = abs( a( i+j*lda ) )
414 aa = abs( a( i+j*lda ) )
417 work( l ) = work( l ) + aa
419 work( j ) = work( j ) + s
424 IF(
VALUE .LT. temp .OR. disnan( temp ) )
437 aa = abs( a( i+j*lda ) )
440 work( i ) = work( i ) + aa
442 aa = abs( a( i+j*lda ) )
446 aa = abs( a( i+j*lda ) )
448 work( j ) = work( j ) + aa
452 aa = abs( a( i+j*lda ) )
455 work( l ) = work( l ) + aa
457 work( j ) = work( j ) + s
462 IF(
VALUE .LT. temp .OR. disnan( temp ) )
473 aa = abs( a( i+j*lda ) )
476 work( i+k ) = work( i+k ) + aa
478 aa = abs( a( i+j*lda ) )
481 work( i+k ) = work( i+k ) + s
484 aa = abs( a( i+j*lda ) )
490 aa = abs( a( i+j*lda ) )
493 work( l ) = work( l ) + aa
495 work( j ) = work( j ) + s
500 IF(
VALUE .LT. temp .OR. disnan( temp ) )
521 aa = abs( a( i+j*lda ) )
523 work( i+n1 ) = work( i+n1 ) + aa
529 s = abs( a( 0+j*lda ) )
532 aa = abs( a( i+j*lda ) )
534 work( i+n1 ) = work( i+n1 ) + aa
537 work( j ) = work( j ) + s
541 aa = abs( a( i+j*lda ) )
543 work( i ) = work( i ) + aa
547 aa = abs( a( i+j*lda ) )
550 work( j-k ) = work( j-k ) + s
552 s = abs( a( i+j*lda ) )
556 aa = abs( a( i+j*lda ) )
558 work( l ) = work( l ) + aa
561 work( j ) = work( j ) + s
566 IF(
VALUE .LT. temp .OR. disnan( temp ) )
580 aa = abs( a( i+j*lda ) )
582 work( i ) = work( i ) + aa
585 aa = abs( a( i+j*lda ) )
592 aa = abs( a( i+j*lda ) )
594 DO l = k + j + 1, n - 1
596 aa = abs( a( i+j*lda ) )
599 work( l ) = work( l ) + aa
601 work( k+j ) = work( k+j ) + s
606 aa = abs( a( i+j*lda ) )
608 work( i ) = work( i ) + aa
612 aa = abs( a( i+j*lda ) )
621 aa = abs( a( i+j*lda ) )
623 work( i ) = work( i ) + aa
626 work( j ) = work( j ) + s
631 IF(
VALUE .LT. temp .OR. disnan( temp ) )
644 aa = abs( a( i+j*lda ) )
646 work( i+k ) = work( i+k ) + aa
652 aa = abs( a( 0+j*lda ) )
656 aa = abs( a( i+j*lda ) )
658 work( i+k ) = work( i+k ) + aa
661 work( j ) = work( j ) + s
665 aa = abs( a( i+j*lda ) )
667 work( i ) = work( i ) + aa
671 aa = abs( a( i+j*lda ) )
674 work( j-k-1 ) = work( j-k-1 ) + s
676 aa = abs( a( i+j*lda ) )
681 aa = abs( a( i+j*lda ) )
683 work( l ) = work( l ) + aa
686 work( j ) = work( j ) + s
691 aa = abs( a( i+j*lda ) )
693 work( i ) = work( i ) + aa
697 aa = abs( a( i+j*lda ) )
700 work( i ) = work( i ) + s
704 IF(
VALUE .LT. temp .OR. disnan( temp ) )
718 work( i+k ) = work( i+k ) + aa
721 work( k ) = work( k ) + s
726 aa = abs( a( i+j*lda ) )
728 work( i ) = work( i ) + aa
731 aa = abs( a( i+j*lda ) )
738 aa = abs( a( i+j*lda ) )
740 DO l = k + j + 1, n - 1
742 aa = abs( a( i+j*lda ) )
745 work( l ) = work( l ) + aa
747 work( k+j ) = work( k+j ) + s
752 aa = abs( a( i+j*lda ) )
754 work( i ) = work( i ) + aa
758 aa = abs( a( i+j*lda ) )
767 aa = abs( a( i+j*lda ) )
769 work( i ) = work( i ) + aa
772 work( j-1 ) = work( j-1 ) + s
777 IF(
VALUE .LT. temp .OR. disnan( temp ) )
783 ELSE IF( ( lsame( norm,
'F' ) ) .OR. ( lsame( norm,
'E' ) ) )
THEN
797 CALL dlassq( k-j-2, a( k+j+1+j*lda ), 1, scale, s )
801 CALL dlassq( k+j-1, a( 0+j*lda ), 1, scale, s )
806 CALL dlassq( k-1, a( k ), lda+1, scale, s )
808 CALL dlassq( k, a( k-1 ), lda+1, scale, s )
813 CALL dlassq( n-j-1, a( j+1+j*lda ), 1, scale, s )
817 CALL dlassq( j, a( 0+( 1+j )*lda ), 1, scale, s )
822 CALL dlassq( k, a( 0 ), lda+1, scale, s )
824 CALL dlassq( k-1, a( 0+lda ), lda+1, scale, s )
832 CALL dlassq( j, a( 0+( k+j )*lda ), 1, scale, s )
836 CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
840 CALL dlassq( k-j-1, a( j+1+( j+k-1 )*lda ), 1,
846 CALL dlassq( k-1, a( 0+k*lda ), lda+1, scale, s )
848 CALL dlassq( k, a( 0+( k-1 )*lda ), lda+1, scale, s )
853 CALL dlassq( j, a( 0+j*lda ), 1, scale, s )
857 CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
861 CALL dlassq( k-j-2, a( j+2+j*lda ), 1, scale, s )
866 CALL dlassq( k, a( 0 ), lda+1, scale, s )
868 CALL dlassq( k-1, a( 1 ), lda+1, scale, s )
879 CALL dlassq( k-j-1, a( k+j+2+j*lda ), 1, scale, s )
883 CALL dlassq( k+j, a( 0+j*lda ), 1, scale, s )
888 CALL dlassq( k, a( k+1 ), lda+1, scale, s )
890 CALL dlassq( k, a( k ), lda+1, scale, s )
895 CALL dlassq( n-j-1, a( j+2+j*lda ), 1, scale, s )
899 CALL dlassq( j, a( 0+j*lda ), 1, scale, s )
904 CALL dlassq( k, a( 1 ), lda+1, scale, s )
906 CALL dlassq( k, a( 0 ), lda+1, scale, s )
914 CALL dlassq( j, a( 0+( k+1+j )*lda ), 1, scale, s )
918 CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
922 CALL dlassq( k-j-1, a( j+1+( j+k )*lda ), 1, scale,
928 CALL dlassq( k, a( 0+( k+1 )*lda ), lda+1, scale, s )
930 CALL dlassq( k, a( 0+k*lda ), lda+1, scale, s )
935 CALL dlassq( j, a( 0+( j+1 )*lda ), 1, scale, s )
939 CALL dlassq( k, a( 0+j*lda ), 1, scale, s )
943 CALL dlassq( k-j-1, a( j+1+j*lda ), 1, scale, s )
948 CALL dlassq( k, a( lda ), lda+1, scale, s )
950 CALL dlassq( k, a( 0 ), lda+1, scale, s )
955 VALUE = scale*sqrt( s )
subroutine dlassq(N, X, INCX, SCALE, SUMSQ)
DLASSQ updates a sum of squares represented in scaled form.
double precision function dlansf(NORM, TRANSR, UPLO, N, A, WORK)
DLANSF returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric matrix in RFP format.