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
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 ) )
310 temp = abs( a( i+
j*lda ) )
322 temp = abs( a( i+
j*lda ) )
331 temp = abs( a( i+
j*lda ) )
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
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
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
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
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
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
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
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
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 )
LOGICAL function lsame(CA, CB)
LSAME
input scalars passed by value
LOGICAL function disnan(DIN)
DISNAN tests input for NaN.
subroutine dlassq(N, X, INCX, SCALE, SUMSQ)
DLASSQ updates a sum of squares represented in scaled form.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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.