141 REAL FUNCTION slantr( NORM, UPLO, DIAG, M, N, A, LDA,
150 CHARACTER diag, norm, uplo
154 REAL a( lda, * ), work( * )
161 parameter( one = 1.0e+0, zero = 0.0e+0 )
166 REAL scale, sum,
value
176 INTRINSIC abs, min, sqrt
180 IF( min( m, n ).EQ.0 )
THEN
182 ELSE IF(
lsame( norm,
'M' ) )
THEN
186 IF(
lsame( diag,
'U' ) )
THEN
188 IF(
lsame( uplo,
'U' ) )
THEN
190 DO 10 i = 1, min( m,
j-1 )
191 sum = abs( a( i,
j ) )
198 sum = abs( a( i,
j ) )
205 IF(
lsame( uplo,
'U' ) )
THEN
207 DO 50 i = 1, min( m,
j )
208 sum = abs( a( i,
j ) )
215 sum = abs( a( i,
j ) )
221 ELSE IF( (
lsame( norm,
'O' ) ) .OR. ( norm.EQ.
'1' ) )
THEN
226 udiag =
lsame( diag,
'U' )
227 IF(
lsame( uplo,
'U' ) )
THEN
229 IF( ( udiag ) .AND. (
j.LE.m ) )
THEN
232 sum = sum + abs( a( i,
j ) )
236 DO 100 i = 1, min( m,
j )
237 sum = sum + abs( a( i,
j ) )
247 sum = sum + abs( a( i,
j ) )
252 sum = sum + abs( a( i,
j ) )
258 ELSE IF(
lsame( norm,
'I' ) )
THEN
262 IF(
lsame( uplo,
'U' ) )
THEN
263 IF(
lsame( diag,
'U' ) )
THEN
268 DO 160 i = 1, min( m,
j-1 )
269 work( i ) = work( i ) + abs( a( i,
j ) )
277 DO 190 i = 1, min( m,
j )
278 work( i ) = work( i ) + abs( a( i,
j ) )
283 IF(
lsame( diag,
'U' ) )
THEN
292 work( i ) = work( i ) + abs( a( i,
j ) )
301 work( i ) = work( i ) + abs( a( i,
j ) )
311 ELSE IF( (
lsame( norm,
'F' ) ) .OR. (
lsame( norm,
'E' ) ) )
THEN
315 IF(
lsame( uplo,
'U' ) )
THEN
316 IF(
lsame( diag,
'U' ) )
THEN
320 CALL
slassq( min( m,
j-1 ), a( 1,
j ), 1, scale, sum )
326 CALL
slassq( min( m,
j ), a( 1,
j ), 1, scale, sum )
330 IF(
lsame( diag,
'U' ) )
THEN
334 CALL
slassq( m-
j, a( min( m,
j+1 ),
j ), 1, scale,
341 CALL
slassq( m-
j+1, a(
j,
j ), 1, scale, sum )
345 value = scale*sqrt( sum )
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
REAL function slantr(NORM, UPLO, DIAG, M, N, A, LDA, WORK)
SLANTR 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.
LOGICAL function sisnan(SIN)
SISNAN tests input for NaN.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j