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.