210 REAL FUNCTION slansf( NORM, TRANSR, UPLO, N, A, WORK )
218 CHARACTER norm, transr, uplo
222 REAL a( 0: * ), work( 0: * )
230 parameter( one = 1.0e+0, zero = 0.0e+0 )
233 INTEGER i,
j, ifm, ilu, noe, n1, k, l, lda
234 REAL scale, s,
value, aa, temp
251 ELSE IF( n.EQ.1 )
THEN
259 IF( mod( n, 2 ).EQ.0 )
265 IF(
lsame( transr,
'T' ) )
271 IF(
lsame( uplo,
'U' ) )
290 IF(
lsame( norm,
'M' ) )
THEN
302 temp = abs( a( i+
j*lda ) )
311 temp = abs( a( i+
j*lda ) )
323 temp = abs( a( i+
j*lda ) )
332 temp = abs( a( i+
j*lda ) )
339 ELSE IF( (
lsame( norm,
'I' ) ) .OR. (
lsame( norm,
'O' ) ) .OR.
340 $ ( norm.EQ.
'1' ) )
THEN
355 aa = abs( a( i+
j*lda ) )
358 work( i ) = work( i ) + aa
360 aa = abs( a( i+
j*lda ) )
366 aa = abs( a( i+
j*lda ) )
368 work(
j ) = work(
j ) + aa
372 aa = abs( a( i+
j*lda ) )
375 work( l ) = work( l ) + aa
377 work(
j ) = work(
j ) + s
396 aa = abs( a( i+
j*lda ) )
399 work( i+k ) = work( i+k ) + aa
402 aa = abs( a( i+
j*lda ) )
405 work( i+k ) = work( i+k ) + s
409 aa = abs( a( i+
j*lda ) )
415 aa = abs( a( i+
j*lda ) )
418 work( l ) = work( l ) + aa
420 work(
j ) = work(
j ) + s
438 aa = abs( a( i+
j*lda ) )
441 work( i ) = work( i ) + aa
443 aa = abs( a( i+
j*lda ) )
447 aa = abs( a( i+
j*lda ) )
449 work(
j ) = work(
j ) + aa
453 aa = abs( a( i+
j*lda ) )
456 work( l ) = work( l ) + aa
458 work(
j ) = work(
j ) + s
474 aa = abs( a( i+
j*lda ) )
477 work( i+k ) = work( i+k ) + aa
479 aa = abs( a( i+
j*lda ) )
482 work( i+k ) = work( i+k ) + s
485 aa = abs( a( i+
j*lda ) )
491 aa = abs( a( i+
j*lda ) )
494 work( l ) = work( l ) + aa
496 work(
j ) = work(
j ) + s
522 aa = abs( a( i+
j*lda ) )
524 work( i+n1 ) = work( i+n1 ) + aa
530 s = abs( a( 0+
j*lda ) )
533 aa = abs( a( i+
j*lda ) )
535 work( i+n1 ) = work( i+n1 ) + aa
538 work(
j ) = work(
j ) + s
542 aa = abs( a( i+
j*lda ) )
544 work( i ) = work( i ) + aa
548 aa = abs( a( i+
j*lda ) )
551 work(
j-k ) = work(
j-k ) + s
553 s = abs( a( i+
j*lda ) )
557 aa = abs( a( i+
j*lda ) )
559 work( l ) = work( l ) + aa
562 work(
j ) = work(
j ) + s
581 aa = abs( a( i+
j*lda ) )
583 work( i ) = work( i ) + aa
586 aa = abs( a( i+
j*lda ) )
593 aa = abs( a( i+
j*lda ) )
595 DO l = k +
j + 1, n - 1
597 aa = abs( a( i+
j*lda ) )
600 work( l ) = work( l ) + aa
602 work( k+
j ) = work( k+
j ) + s
607 aa = abs( a( i+
j*lda ) )
609 work( i ) = work( i ) + aa
613 aa = abs( a( i+
j*lda ) )
622 aa = abs( a( i+
j*lda ) )
624 work( i ) = work( i ) + aa
627 work(
j ) = work(
j ) + s
645 aa = abs( a( i+
j*lda ) )
647 work( i+k ) = work( i+k ) + aa
653 aa = abs( a( 0+
j*lda ) )
657 aa = abs( a( i+
j*lda ) )
659 work( i+k ) = work( i+k ) + aa
662 work(
j ) = work(
j ) + s
666 aa = abs( a( i+
j*lda ) )
668 work( i ) = work( i ) + aa
672 aa = abs( a( i+
j*lda ) )
675 work(
j-k-1 ) = work(
j-k-1 ) + s
677 aa = abs( a( i+
j*lda ) )
682 aa = abs( a( i+
j*lda ) )
684 work( l ) = work( l ) + aa
687 work(
j ) = work(
j ) + s
692 aa = abs( a( i+
j*lda ) )
694 work( i ) = work( i ) + aa
698 aa = abs( a( i+
j*lda ) )
701 work( i ) = work( i ) + s
719 work( i+k ) = work( i+k ) + aa
722 work( k ) = work( k ) + s
727 aa = abs( a( i+
j*lda ) )
729 work( i ) = work( i ) + aa
732 aa = abs( a( i+
j*lda ) )
739 aa = abs( a( i+
j*lda ) )
741 DO l = k +
j + 1, n - 1
743 aa = abs( a( i+
j*lda ) )
746 work( l ) = work( l ) + aa
748 work( k+
j ) = work( k+
j ) + s
753 aa = abs( a( i+
j*lda ) )
755 work( i ) = work( i ) + aa
759 aa = abs( a( i+
j*lda ) )
768 aa = abs( a( i+
j*lda ) )
770 work( i ) = work( i ) + aa
773 work(
j-1 ) = work(
j-1 ) + s
784 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
798 CALL
slassq( k-
j-2, a( k+
j+1+
j*lda ), 1, scale, s )
802 CALL
slassq( k+
j-1, a( 0+
j*lda ), 1, scale, s )
807 CALL
slassq( k-1, a( k ), lda+1, scale, s )
809 CALL
slassq( k, a( k-1 ), lda+1, scale, s )
814 CALL
slassq( n-
j-1, a(
j+1+
j*lda ), 1, scale, s )
818 CALL
slassq(
j, a( 0+( 1+
j )*lda ), 1, scale, s )
823 CALL
slassq( k, a( 0 ), lda+1, scale, s )
825 CALL
slassq( k-1, a( 0+lda ), lda+1, scale, s )
833 CALL
slassq(
j, a( 0+( k+
j )*lda ), 1, scale, s )
837 CALL
slassq( k, a( 0+
j*lda ), 1, scale, s )
841 CALL
slassq( k-
j-1, a(
j+1+(
j+k-1 )*lda ), 1,
847 CALL
slassq( k-1, a( 0+k*lda ), lda+1, scale, s )
849 CALL
slassq( k, a( 0+( k-1 )*lda ), lda+1, scale, s )
854 CALL
slassq(
j, a( 0+
j*lda ), 1, scale, s )
858 CALL
slassq( k, a( 0+
j*lda ), 1, scale, s )
862 CALL
slassq( k-
j-2, a(
j+2+
j*lda ), 1, scale, s )
867 CALL
slassq( k, a( 0 ), lda+1, scale, s )
869 CALL
slassq( k-1, a( 1 ), lda+1, scale, s )
880 CALL
slassq( k-
j-1, a( k+
j+2+
j*lda ), 1, scale, s )
884 CALL
slassq( k+
j, a( 0+
j*lda ), 1, scale, s )
889 CALL
slassq( k, a( k+1 ), lda+1, scale, s )
891 CALL
slassq( k, a( k ), lda+1, scale, s )
896 CALL
slassq( n-
j-1, a(
j+2+
j*lda ), 1, scale, s )
900 CALL
slassq(
j, a( 0+
j*lda ), 1, scale, s )
905 CALL
slassq( k, a( 1 ), lda+1, scale, s )
907 CALL
slassq( k, a( 0 ), lda+1, scale, s )
915 CALL
slassq(
j, a( 0+( k+1+
j )*lda ), 1, scale, s )
919 CALL
slassq( k, a( 0+
j*lda ), 1, scale, s )
923 CALL
slassq( k-
j-1, a(
j+1+(
j+k )*lda ), 1, scale,
929 CALL
slassq( k, a( 0+( k+1 )*lda ), lda+1, scale, s )
931 CALL
slassq( k, a( 0+k*lda ), lda+1, scale, s )
936 CALL
slassq(
j, a( 0+(
j+1 )*lda ), 1, scale, s )
940 CALL
slassq( k, a( 0+
j*lda ), 1, scale, s )
944 CALL
slassq( k-
j-1, a(
j+1+
j*lda ), 1, scale, s )
949 CALL
slassq( k, a( lda ), lda+1, scale, s )
951 CALL
slassq( k, a( 0 ), lda+1, scale, s )
956 value = scale*sqrt( s )
subroutine slassq(N, X, INCX, SCALE, SUMSQ)
SLASSQ updates a sum of squares represented in scaled form.
LOGICAL function lsame(CA, CB)
LSAME
input scalars passed by value
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
REAL function slansf(NORM, TRANSR, UPLO, N, A, WORK)
SLANSF
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j