142 REAL FUNCTION clantr( NORM, UPLO, DIAG, M, N, A, LDA,
151 CHARACTER diag, norm, uplo
163 parameter( one = 1.0e+0, zero = 0.0e+0 )
168 REAL scale, sum,
value
178 INTRINSIC abs, min, sqrt
182 IF( min( m, n ).EQ.0 )
THEN
184 ELSE IF(
lsame( norm,
'M' ) )
THEN
188 IF(
lsame( diag,
'U' ) )
THEN
190 IF(
lsame( uplo,
'U' ) )
THEN
192 DO 10 i = 1, min( m,
j-1 )
193 sum = abs( a( i,
j ) )
200 sum = abs( a( i,
j ) )
207 IF(
lsame( uplo,
'U' ) )
THEN
209 DO 50 i = 1, min( m,
j )
210 sum = abs( a( i,
j ) )
217 sum = abs( a( i,
j ) )
223 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
228 udiag =
lsame( diag,
'U' )
229 IF(
lsame( uplo,
'U' ) )
THEN
231 IF( ( udiag ) .AND. (
j.LE.m ) )
THEN
234 sum = sum + abs( a( i,
j ) )
238 DO 100 i = 1, min( m,
j )
239 sum = sum + abs( a( i,
j ) )
249 sum = sum + abs( a( i,
j ) )
254 sum = sum + abs( a( i,
j ) )
260 ELSE IF(
lsame( norm,
'I' ) )
THEN
264 IF(
lsame( uplo,
'U' ) )
THEN
265 IF(
lsame( diag,
'U' ) )
THEN
270 DO 160 i = 1, min( m,
j-1 )
271 work( i ) = work( i ) + abs( a( i,
j ) )
279 DO 190 i = 1, min( m,
j )
280 work( i ) = work( i ) + abs( a( i,
j ) )
285 IF(
lsame( diag,
'U' ) )
THEN
294 work( i ) = work( i ) + abs( a( i,
j ) )
303 work( i ) = work( i ) + abs( a( i,
j ) )
313 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
317 IF(
lsame( uplo,
'U' ) )
THEN
318 IF(
lsame( diag,
'U' ) )
THEN
322 CALL
classq( min( m,
j-1 ), a( 1,
j ), 1, scale, sum )
328 CALL
classq( min( m,
j ), a( 1,
j ), 1, scale, sum )
332 IF(
lsame( diag,
'U' ) )
THEN
336 CALL
classq( m-
j, a( min( m,
j+1 ),
j ), 1, scale,
343 CALL
classq( m-
j+1, a(
j,
j ), 1, scale, sum )
347 value = scale*sqrt( sum )
LOGICAL function lsame(CA, CB)
LSAME
input scalars passed by value
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
REAL function clantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
CLANTR returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a trapezoidal or triangular matrix.
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j