diff options
| author | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-07-16 14:21:07 +0000 |
|---|---|---|
| committer | james <james@8a072113-8704-0410-8d35-dd094bca7971> | 2012-07-16 14:21:07 +0000 |
| commit | b0ccd072d7381538a5947bc93908abeabaaf83d8 (patch) | |
| tree | fc3e26f33d620d6968d56441ca92a256a071c3e6 | |
| parent | 8989738d77f02c7b50839e69ab8a2ed8aac75024 (diff) | |
| download | lapack-b0ccd072d7381538a5947bc93908abeabaaf83d8.tar.gz lapack-b0ccd072d7381538a5947bc93908abeabaaf83d8.tar.bz2 lapack-b0ccd072d7381538a5947bc93908abeabaaf83d8.zip | |
matrix norms now consistently return nan when input matrix contains a nan;
previously, this was (usually) only the case for the 'F' norm
| -rw-r--r-- | SRC/clangb.f | 14 | ||||
| -rw-r--r-- | SRC/clange.f | 16 | ||||
| -rw-r--r-- | SRC/clangt.f | 35 | ||||
| -rw-r--r-- | SRC/clanhb.f | 21 | ||||
| -rw-r--r-- | SRC/clanhe.f | 23 | ||||
| -rw-r--r-- | SRC/clanhf.f | 307 | ||||
| -rw-r--r-- | SRC/clanhp.f | 23 | ||||
| -rw-r--r-- | SRC/clanhs.f | 14 | ||||
| -rw-r--r-- | SRC/clanht.f | 21 | ||||
| -rw-r--r-- | SRC/clansb.f | 15 | ||||
| -rw-r--r-- | SRC/clansp.f | 17 | ||||
| -rw-r--r-- | SRC/clansy.f | 17 | ||||
| -rw-r--r-- | SRC/clantb.f | 23 | ||||
| -rw-r--r-- | SRC/clantp.f | 25 | ||||
| -rw-r--r-- | SRC/clantr.f | 25 | ||||
| -rw-r--r-- | SRC/dlangb.f | 14 | ||||
| -rw-r--r-- | SRC/dlange.f | 16 | ||||
| -rw-r--r-- | SRC/dlangt.f | 35 | ||||
| -rw-r--r-- | SRC/dlanhs.f | 14 | ||||
| -rw-r--r-- | SRC/dlansb.f | 15 | ||||
| -rw-r--r-- | SRC/dlansf.f | 87 | ||||
| -rw-r--r-- | SRC/dlansp.f | 17 | ||||
| -rw-r--r-- | SRC/dlanst.f | 21 | ||||
| -rw-r--r-- | SRC/dlansy.f | 17 | ||||
| -rw-r--r-- | SRC/dlantb.f | 23 | ||||
| -rw-r--r-- | SRC/dlantp.f | 25 | ||||
| -rw-r--r-- | SRC/dlantr.f | 25 | ||||
| -rw-r--r-- | SRC/slangb.f | 14 | ||||
| -rw-r--r-- | SRC/slange.f | 16 | ||||
| -rw-r--r-- | SRC/slangt.f | 35 | ||||
| -rw-r--r-- | SRC/slanhs.f | 14 | ||||
| -rw-r--r-- | SRC/slansb.f | 15 | ||||
| -rw-r--r-- | SRC/slansf.f | 91 | ||||
| -rw-r--r-- | SRC/slansp.f | 17 | ||||
| -rw-r--r-- | SRC/slanst.f | 21 | ||||
| -rw-r--r-- | SRC/slansy.f | 17 | ||||
| -rw-r--r-- | SRC/slantb.f | 23 | ||||
| -rw-r--r-- | SRC/slantp.f | 25 | ||||
| -rw-r--r-- | SRC/slantr.f | 25 | ||||
| -rw-r--r-- | SRC/zlangb.f | 14 | ||||
| -rw-r--r-- | SRC/zlange.f | 16 | ||||
| -rw-r--r-- | SRC/zlangt.f | 35 | ||||
| -rw-r--r-- | SRC/zlanhb.f | 21 | ||||
| -rw-r--r-- | SRC/zlanhe.f | 23 | ||||
| -rw-r--r-- | SRC/zlanhf.f | 305 | ||||
| -rw-r--r-- | SRC/zlanhp.f | 23 | ||||
| -rw-r--r-- | SRC/zlanhs.f | 14 | ||||
| -rw-r--r-- | SRC/zlanht.f | 19 | ||||
| -rw-r--r-- | SRC/zlansb.f | 15 | ||||
| -rw-r--r-- | SRC/zlansp.f | 17 | ||||
| -rw-r--r-- | SRC/zlansy.f | 17 | ||||
| -rw-r--r-- | SRC/zlantb.f | 23 | ||||
| -rw-r--r-- | SRC/zlantp.f | 25 | ||||
| -rw-r--r-- | SRC/zlantr.f | 25 |
54 files changed, 1182 insertions, 628 deletions
diff --git a/SRC/clangb.f b/SRC/clangb.f index 9f9f2355..005435c2 100644 --- a/SRC/clangb.f +++ b/SRC/clangb.f @@ -147,11 +147,11 @@ * .. * .. Local Scalars .. INTEGER I, J, K, L - REAL SCALE, SUM, VALUE + REAL SCALE, SUM, VALUE, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ @@ -170,7 +170,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + TEMP = ABS( AB( I, J ) ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -183,7 +184,7 @@ DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) SUM = SUM + ABS( AB( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. SISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -200,7 +201,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/clange.f b/SRC/clange.f index 9db808e5..56ecb0b2 100644 --- a/SRC/clange.f +++ b/SRC/clange.f @@ -137,17 +137,17 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL SCALE, SUM, VALUE + REAL SCALE, SUM, VALUE, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -160,7 +160,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + TEMP = ABS( A( I, J ) ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -173,7 +174,7 @@ DO 30 I = 1, M SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. SISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -189,7 +190,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/clangt.f b/SRC/clangt.f index ea32ac2d..1bac73cb 100644 --- a/SRC/clangt.f +++ b/SRC/clangt.f @@ -127,17 +127,17 @@ * .. * .. Local Scalars .. INTEGER I - REAL ANORM, SCALE, SUM + REAL ANORM, SCALE, SUM, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -149,9 +149,12 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( DL( I ) ) ) - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( DU( I ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. SISNAN( ABS( DL( I ) ) ) ) + $ ANORM = ABS(DL(I)) + IF( ANORM.LT.ABS( D( I ) ) .OR. SISNAN( ABS( D( I ) ) ) ) + $ ANORM = ABS(D(I)) + IF( ANORM.LT.ABS( DU( I ) ) .OR. SISNAN (ABS( DU( I ) ) ) ) + $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN * @@ -160,11 +163,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DL( 1 ) ), - $ ABS( D( N ) )+ABS( DU( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DU( N-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DL( I ) )+ - $ ABS( DU( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP 20 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -174,11 +178,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DU( 1 ) ), - $ ABS( D( N ) )+ABS( DL( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DL( N-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP DO 30 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DU( I ) )+ - $ ABS( DL( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clanhb.f b/SRC/clanhb.f index a0a70cc3..b879dcc9 100644 --- a/SRC/clanhb.f +++ b/SRC/clanhb.f @@ -157,8 +157,8 @@ REAL ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ @@ -178,15 +178,19 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE - VALUE = MAX( VALUE, ABS( REAL( AB( K+1, J ) ) ) ) + SUM = ABS( REAL( AB( K+1, J ) ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 20 CONTINUE ELSE DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( REAL( AB( 1, J ) ) ) ) + SUM = ABS( REAL( AB( 1, J ) ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM DO 30 I = 2, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -208,7 +212,8 @@ WORK( J ) = SUM + ABS( REAL( AB( K+1, J ) ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -222,7 +227,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clanhe.f b/SRC/clanhe.f index fb7a36a9..89b26e9d 100644 --- a/SRC/clanhe.f +++ b/SRC/clanhe.f @@ -149,14 +149,14 @@ REAL ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, REAL, SQRT + INTRINSIC ABS, REAL, SQRT * .. * .. Executable Statements .. * @@ -170,15 +170,19 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, J - 1 - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE - VALUE = MAX( VALUE, ABS( REAL( A( J, J ) ) ) ) + SUM = ABS( REAL( A( J, J ) ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 20 CONTINUE ELSE DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( REAL( A( J, J ) ) ) ) + SUM = ABS( REAL( A( J, J ) ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM DO 30 I = J + 1, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -199,7 +203,8 @@ WORK( J ) = SUM + ABS( REAL( A( J, J ) ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -212,7 +217,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clanhf.f b/SRC/clanhf.f index 5f38ff33..293fc830 100644 --- a/SRC/clanhf.f +++ b/SRC/clanhf.f @@ -268,18 +268,17 @@ * .. * .. Local Scalars .. INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA - REAL SCALE, S, VALUE, AA + REAL SCALE, S, VALUE, AA, TEMP * .. * .. External Functions .. - LOGICAL LSAME - INTEGER ISAMAX - EXTERNAL LSAME, ISAMAX + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, REAL, MAX, SQRT + INTRINSIC ABS, REAL, SQRT * .. * .. Executable Statements .. * @@ -339,46 +338,70 @@ * uplo ='L' J = 0 * -> L(0,0) - VALUE = MAX( VALUE, ABS( REAL( A( J+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( J+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = 1, K - 1 DO I = 0, J - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - 1 * L(k+j,k+j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = J * -> L(j,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 1, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 2 DO I = 0, K + J - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K + J - 1 * -> U(i,i) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = I + 1 * =k+j; i -> U(j,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = K + J + 1, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO DO I = 0, N - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP * j=k-1 END DO * i=n-1 -> U(n-1,n-1) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END IF ELSE * xpose case; A is k by n @@ -386,55 +409,83 @@ * uplo ='L' DO J = 0, K - 2 DO I = 0, J - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J * L(i,i) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = J + 1 * L(j+k,j+k) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 2, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K - 1 DO I = 0, K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K - 1 * -> L(i,i) is at A(i,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO J = K, N - 1 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 2 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K - 1 * -> U(j,j) is at A(0,j) - VALUE = MAX( VALUE, ABS( REAL( A( 0+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( 0+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = K, N - 1 DO I = 0, J - K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - K * -> U(i,i) at A(i,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = J - K + 1 * U(j,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J - K + 2, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO END IF @@ -447,50 +498,78 @@ * uplo ='L' J = 0 * -> L(k,k) & j=1 -> L(0,0) - VALUE = MAX( VALUE, ABS( REAL( A( J+J*LDA ) ) ) ) - VALUE = MAX( VALUE, ABS( REAL( A( J+1+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( J+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + TEMP = ABS( REAL( A( J+1+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 2, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = 1, K - 1 DO I = 0, J - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J * L(k+j,k+j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = J + 1 * -> L(j,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 2, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 2 DO I = 0, K + J - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K + J * -> U(i,i) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = I + 1 * =k+j+1; i -> U(j,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = K + J + 2, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO DO I = 0, N - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) -* j=k-1 + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP +* j=k-1 END DO * i=n-1 -> U(n-1,n-1) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = N * -> U(k-1,k-1) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END IF ELSE * xpose case; A is k by n+1 @@ -498,70 +577,106 @@ * uplo ='L' J = 0 * -> L(k,k) at A(0,0) - VALUE = MAX( VALUE, ABS( REAL( A( J+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( J+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = 1, K - 1 DO I = 0, J - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - 1 * L(i,i) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = J * L(j+k,j+k) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K DO I = 0, K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K - 1 * -> L(i,i) is at A(i,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO J = K + 1, N DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 1 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K * -> U(j,j) is at A(0,j) - VALUE = MAX( VALUE, ABS( REAL( A( 0+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( 0+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = K + 1, N - 1 DO I = 0, J - K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - K - 1 * -> U(i,i) at A(i,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP I = J - K * U(j,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J - K + 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = N DO I = 0, K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K - 1 * U(k,k) at A(i,j) - VALUE = MAX( VALUE, ABS( REAL( A( I+J*LDA ) ) ) ) + TEMP = ABS( REAL( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END IF END IF END IF @@ -608,8 +723,12 @@ WORK( J ) = WORK( J ) + S END DO 10 CONTINUE - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 & uplo = 'L' K = K + 1 @@ -646,8 +765,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even & A is n+1 by k = n/2 @@ -681,8 +804,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 & uplo = 'L' DO I = K, N - 1 @@ -715,8 +842,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF ELSE @@ -778,8 +909,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 & uplo = 'L' K = K + 1 @@ -839,8 +974,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even & A is k=n/2 by n+1 @@ -909,8 +1048,12 @@ * A(k-1,k-1) S = S + AA WORK( I ) = WORK( I ) + S - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 & uplo = 'L' DO I = K, N - 1 @@ -980,8 +1123,12 @@ END DO WORK( J-1 ) = WORK( J-1 ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF END IF diff --git a/SRC/clanhp.f b/SRC/clanhp.f index 8c3f4de9..85d98aa5 100644 --- a/SRC/clanhp.f +++ b/SRC/clanhp.f @@ -142,14 +142,14 @@ REAL ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, REAL, SQRT + INTRINSIC ABS, REAL, SQRT * .. * .. Executable Statements .. * @@ -164,17 +164,21 @@ K = 0 DO 20 J = 1, N DO 10 I = K + 1, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J - VALUE = MAX( VALUE, ABS( REAL( AP( K ) ) ) ) + SUM = ABS( REAL( AP( K ) ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 20 CONTINUE ELSE K = 1 DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( REAL( AP( K ) ) ) ) + SUM = ABS( REAL( AP( K ) ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM DO 30 I = K + 1, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -199,7 +203,8 @@ K = K + 1 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -214,7 +219,7 @@ WORK( I ) = WORK( I ) + ABSA K = K + 1 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clanhs.f b/SRC/clanhs.f index 972c3ff5..3462416d 100644 --- a/SRC/clanhs.f +++ b/SRC/clanhs.f @@ -134,14 +134,14 @@ REAL SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -154,7 +154,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, MIN( N, J+1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -167,7 +168,7 @@ DO 30 I = 1, MIN( N, J+1 ) SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -183,7 +184,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/clanht.f b/SRC/clanht.f index be2481a6..4cd37a8d 100644 --- a/SRC/clanht.f +++ b/SRC/clanht.f @@ -126,14 +126,14 @@ REAL ANORM, SCALE, SUM * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ, SLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -145,8 +145,10 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( E( I ) ) ) + SUM = ABS( D( I ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM + SUM = ABS( E( I ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR. $ LSAME( NORM, 'I' ) ) THEN @@ -156,11 +158,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ), - $ ABS( E( N-1 ) )+ABS( D( N ) ) ) + ANORM = ABS( D( 1 ) )+ABS( E( 1 ) ) + SUM = ABS( E( N-1 ) )+ABS( D( N ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( E( I ) )+ - $ ABS( E( I-1 ) ) ) + SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clansb.f b/SRC/clansb.f index efc46dae..4bb46103 100644 --- a/SRC/clansb.f +++ b/SRC/clansb.f @@ -155,8 +155,8 @@ REAL ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ @@ -176,13 +176,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -204,7 +206,8 @@ WORK( J ) = SUM + ABS( AB( K+1, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -218,7 +221,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clansp.f b/SRC/clansp.f index 0f182e4b..6f2eb4cd 100644 --- a/SRC/clansp.f +++ b/SRC/clansp.f @@ -140,14 +140,14 @@ REAL ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, AIMAG, MAX, REAL, SQRT + INTRINSIC ABS, AIMAG, REAL, SQRT * .. * .. Executable Statements .. * @@ -162,7 +162,8 @@ K = 1 DO 20 J = 1, N DO 10 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -170,7 +171,8 @@ K = 1 DO 40 J = 1, N DO 30 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -195,7 +197,8 @@ K = K + 1 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -210,7 +213,7 @@ WORK( I ) = WORK( I ) + ABSA K = K + 1 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clansy.f b/SRC/clansy.f index 20c35560..b322eca2 100644 --- a/SRC/clansy.f +++ b/SRC/clansy.f @@ -148,14 +148,14 @@ REAL ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -169,13 +169,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, J - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -196,7 +198,8 @@ WORK( J ) = SUM + ABS( A( J, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -209,7 +212,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/clantb.f b/SRC/clantb.f index 5462dc8e..6517c73a 100644 --- a/SRC/clantb.f +++ b/SRC/clantb.f @@ -167,8 +167,8 @@ REAL SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ @@ -189,13 +189,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -204,13 +206,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -234,7 +238,7 @@ SUM = SUM + ABS( AB( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -249,7 +253,7 @@ SUM = SUM + ABS( AB( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -303,7 +307,8 @@ END IF END IF DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/clantp.f b/SRC/clantp.f index bafab3f2..e50d6618 100644 --- a/SRC/clantp.f +++ b/SRC/clantp.f @@ -151,14 +151,14 @@ REAL SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -174,14 +174,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = K, K + J - 2 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = K + 1, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -191,14 +193,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -225,7 +229,7 @@ 100 CONTINUE END IF K = K + J - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -241,7 +245,7 @@ 130 CONTINUE END IF K = K + N - J + 1 - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -298,7 +302,8 @@ END IF VALUE = ZERO DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/clantr.f b/SRC/clantr.f index 658fbbe5..d8e112d4 100644 --- a/SRC/clantr.f +++ b/SRC/clantr.f @@ -168,14 +168,14 @@ REAL SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL CLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -190,13 +190,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -205,13 +207,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -235,7 +239,7 @@ SUM = SUM + ABS( A( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -250,7 +254,7 @@ SUM = SUM + ABS( A( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -303,7 +307,8 @@ END IF VALUE = ZERO DO 280 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 280 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/dlangb.f b/SRC/dlangb.f index 6aa5527b..9e4785d4 100644 --- a/SRC/dlangb.f +++ b/SRC/dlangb.f @@ -146,14 +146,14 @@ * .. * .. Local Scalars .. INTEGER I, J, K, L - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SCALE, SUM, VALUE, TEMP * .. * .. External Subroutines .. EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -169,7 +169,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + TEMP = ABS( AB( I, J ) ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -182,7 +183,7 @@ DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) SUM = SUM + ABS( AB( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -199,7 +200,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/dlange.f b/SRC/dlange.f index d2118974..9dd9af33 100644 --- a/SRC/dlange.f +++ b/SRC/dlange.f @@ -135,17 +135,17 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SCALE, SUM, VALUE, TEMP * .. * .. External Subroutines .. EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -158,7 +158,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + TEMP = ABS( A( I, J ) ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -171,7 +172,7 @@ DO 30 I = 1, M SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -187,7 +188,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/dlangt.f b/SRC/dlangt.f index 9b77232e..b5e9db2d 100644 --- a/SRC/dlangt.f +++ b/SRC/dlangt.f @@ -127,17 +127,17 @@ * .. * .. Local Scalars .. INTEGER I - DOUBLE PRECISION ANORM, SCALE, SUM + DOUBLE PRECISION ANORM, SCALE, SUM, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL DLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -149,9 +149,12 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( DL( I ) ) ) - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( DU( I ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. DISNAN( ABS( DL( I ) ) ) ) + $ ANORM = ABS(DL(I)) + IF( ANORM.LT.ABS( D( I ) ) .OR. DISNAN( ABS( D( I ) ) ) ) + $ ANORM = ABS(D(I)) + IF( ANORM.LT.ABS( DU( I ) ) .OR. DISNAN (ABS( DU( I ) ) ) ) + $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN * @@ -160,11 +163,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DL( 1 ) ), - $ ABS( D( N ) )+ABS( DU( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DU( N-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DL( I ) )+ - $ ABS( DU( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP 20 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -174,11 +178,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DU( 1 ) ), - $ ABS( D( N ) )+ABS( DL( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DL( N-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP DO 30 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DU( I ) )+ - $ ABS( DL( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/dlanhs.f b/SRC/dlanhs.f index 66721968..db8e6d74 100644 --- a/SRC/dlanhs.f +++ b/SRC/dlanhs.f @@ -135,11 +135,11 @@ EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -152,7 +152,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, MIN( N, J+1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -165,7 +166,7 @@ DO 30 I = 1, MIN( N, J+1 ) SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -181,7 +182,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/dlansb.f b/SRC/dlansb.f index 1f6fdb83..fdaa1b7d 100644 --- a/SRC/dlansb.f +++ b/SRC/dlansb.f @@ -156,8 +156,8 @@ EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -174,13 +174,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -202,7 +204,8 @@ WORK( J ) = SUM + ABS( AB( K+1, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -216,7 +219,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/dlansf.f b/SRC/dlansf.f index b7926267..e03802ee 100644 --- a/SRC/dlansf.f +++ b/SRC/dlansf.f @@ -230,12 +230,11 @@ * .. * .. Local Scalars .. INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA - DOUBLE PRECISION SCALE, S, VALUE, AA + DOUBLE PRECISION SCALE, S, VALUE, AA, TEMP * .. * .. External Functions .. - LOGICAL LSAME - INTEGER IDAMAX - EXTERNAL LSAME, IDAMAX + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL DLASSQ @@ -299,14 +298,18 @@ * A is n by k DO J = 0, K - 1 DO I = 0, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * xpose case; A is k by n DO J = 0, N - 1 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO END IF @@ -316,14 +319,18 @@ * A is n+1 by k DO J = 0, K - 1 DO I = 0, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * xpose case; A is k by n+1 DO J = 0, N DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO END IF @@ -369,8 +376,12 @@ WORK( J ) = WORK( J ) + S END DO 10 CONTINUE - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 K = K + 1 @@ -407,8 +418,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even @@ -441,8 +456,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 DO I = K, N - 1 @@ -475,8 +494,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF ELSE @@ -537,8 +560,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 K = K + 1 @@ -598,8 +625,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even @@ -667,8 +698,12 @@ * A(k-1,k-1) S = S + AA WORK( I ) = WORK( I ) + S - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 DO I = K, N - 1 @@ -736,8 +771,12 @@ END DO WORK( J-1 ) = WORK( J-1 ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF END IF diff --git a/SRC/dlansp.f b/SRC/dlansp.f index 96adcf6f..6f8d8ec9 100644 --- a/SRC/dlansp.f +++ b/SRC/dlansp.f @@ -141,11 +141,11 @@ EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -160,7 +160,8 @@ K = 1 DO 20 J = 1, N DO 10 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -168,7 +169,8 @@ K = 1 DO 40 J = 1, N DO 30 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -193,7 +195,8 @@ K = K + 1 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -208,7 +211,7 @@ WORK( I ) = WORK( I ) + ABSA K = K + 1 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/dlanst.f b/SRC/dlanst.f index 1e15ccc5..9bd608c8 100644 --- a/SRC/dlanst.f +++ b/SRC/dlanst.f @@ -124,14 +124,14 @@ DOUBLE PRECISION ANORM, SCALE, SUM * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL DLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -143,8 +143,10 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( E( I ) ) ) + SUM = ABS( D( I ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM + SUM = ABS( E( I ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR. $ LSAME( NORM, 'I' ) ) THEN @@ -154,11 +156,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ), - $ ABS( E( N-1 ) )+ABS( D( N ) ) ) + ANORM = ABS( D( 1 ) )+ABS( E( 1 ) ) + SUM = ABS( E( N-1 ) )+ABS( D( N ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( E( I ) )+ - $ ABS( E( I-1 ) ) ) + SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/dlansy.f b/SRC/dlansy.f index 1d5e283c..89837150 100644 --- a/SRC/dlansy.f +++ b/SRC/dlansy.f @@ -149,11 +149,11 @@ EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -167,13 +167,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, J - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -194,7 +196,8 @@ WORK( J ) = SUM + ABS( A( J, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -207,7 +210,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/dlantb.f b/SRC/dlantb.f index 95bc64bc..02609bd0 100644 --- a/SRC/dlantb.f +++ b/SRC/dlantb.f @@ -168,8 +168,8 @@ EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -187,13 +187,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -202,13 +204,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -232,7 +236,7 @@ SUM = SUM + ABS( AB( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -247,7 +251,7 @@ SUM = SUM + ABS( AB( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -301,7 +305,8 @@ END IF END IF DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/dlantp.f b/SRC/dlantp.f index 389daa65..bf9c8da9 100644 --- a/SRC/dlantp.f +++ b/SRC/dlantp.f @@ -152,11 +152,11 @@ EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -172,14 +172,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = K, K + J - 2 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = K + 1, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -189,14 +191,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -223,7 +227,7 @@ 100 CONTINUE END IF K = K + J - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -239,7 +243,7 @@ 130 CONTINUE END IF K = K + N - J + 1 - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -296,7 +300,8 @@ END IF VALUE = ZERO DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/dlantr.f b/SRC/dlantr.f index 9ff04b5b..fe87bae0 100644 --- a/SRC/dlantr.f +++ b/SRC/dlantr.f @@ -169,11 +169,11 @@ EXTERNAL DLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -188,13 +188,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -203,13 +205,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -233,7 +237,7 @@ SUM = SUM + ABS( A( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -248,7 +252,7 @@ SUM = SUM + ABS( A( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -301,7 +305,8 @@ END IF VALUE = ZERO DO 280 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 280 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/slangb.f b/SRC/slangb.f index 4449096d..505bac75 100644 --- a/SRC/slangb.f +++ b/SRC/slangb.f @@ -146,14 +146,14 @@ * .. * .. Local Scalars .. INTEGER I, J, K, L - REAL SCALE, SUM, VALUE + REAL SCALE, SUM, VALUE, TEMP * .. * .. External Subroutines .. EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -169,7 +169,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + TEMP = ABS( AB( I, J ) ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -182,7 +183,7 @@ DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) SUM = SUM + ABS( AB( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. SISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -199,7 +200,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/slange.f b/SRC/slange.f index c146f19b..9fb680b9 100644 --- a/SRC/slange.f +++ b/SRC/slange.f @@ -135,17 +135,17 @@ * .. * .. Local Scalars .. INTEGER I, J - REAL SCALE, SUM, VALUE + REAL SCALE, SUM, VALUE, TEMP * .. * .. External Subroutines .. EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -158,7 +158,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + TEMP = ABS( A( I, J ) ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -171,7 +172,7 @@ DO 30 I = 1, M SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. SISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -187,7 +188,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. SISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/slangt.f b/SRC/slangt.f index cfbb68e1..55d92cc2 100644 --- a/SRC/slangt.f +++ b/SRC/slangt.f @@ -127,17 +127,17 @@ * .. * .. Local Scalars .. INTEGER I - REAL ANORM, SCALE, SUM + REAL ANORM, SCALE, SUM, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL SLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -149,9 +149,12 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( DL( I ) ) ) - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( DU( I ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. SISNAN( ABS( DL( I ) ) ) ) + $ ANORM = ABS(DL(I)) + IF( ANORM.LT.ABS( D( I ) ) .OR. SISNAN( ABS( D( I ) ) ) ) + $ ANORM = ABS(D(I)) + IF( ANORM.LT.ABS( DU( I ) ) .OR. SISNAN (ABS( DU( I ) ) ) ) + $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN * @@ -160,11 +163,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DL( 1 ) ), - $ ABS( D( N ) )+ABS( DU( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DU( N-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DL( I ) )+ - $ ABS( DU( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP 20 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -174,11 +178,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DU( 1 ) ), - $ ABS( D( N ) )+ABS( DL( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DL( N-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP DO 30 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DU( I ) )+ - $ ABS( DL( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) ) + IF( ANORM .LT. TEMP .OR. SISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/slanhs.f b/SRC/slanhs.f index b662d7c0..f1c6c5f2 100644 --- a/SRC/slanhs.f +++ b/SRC/slanhs.f @@ -135,11 +135,11 @@ EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -152,7 +152,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, MIN( N, J+1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -165,7 +166,7 @@ DO 30 I = 1, MIN( N, J+1 ) SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -181,7 +182,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/slansb.f b/SRC/slansb.f index 8274221f..36ef437c 100644 --- a/SRC/slansb.f +++ b/SRC/slansb.f @@ -156,8 +156,8 @@ EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -174,13 +174,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -202,7 +204,8 @@ WORK( J ) = SUM + ABS( AB( K+1, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -216,7 +219,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/slansf.f b/SRC/slansf.f index f13c85af..e0e36b5d 100644 --- a/SRC/slansf.f +++ b/SRC/slansf.f @@ -1,4 +1,4 @@ -*> \brief \b SLANSF 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. +*> \brief \b SLANSF * * =========== DOCUMENTATION =========== * @@ -231,18 +231,17 @@ * .. * .. Local Scalars .. INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA - REAL SCALE, S, VALUE, AA + REAL SCALE, S, VALUE, AA, TEMP * .. * .. External Functions .. - LOGICAL LSAME - INTEGER ISAMAX - EXTERNAL LSAME, ISAMAX + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL SLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -300,14 +299,18 @@ * A is n by k DO J = 0, K - 1 DO I = 0, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * xpose case; A is k by n DO J = 0, N - 1 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO END IF @@ -317,14 +320,18 @@ * A is n+1 by k DO J = 0, K - 1 DO I = 0, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * xpose case; A is k by n+1 DO J = 0, N DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO END IF @@ -370,8 +377,12 @@ WORK( J ) = WORK( J ) + S END DO 10 CONTINUE - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 K = K + 1 @@ -408,8 +419,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even @@ -442,8 +457,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 DO I = K, N - 1 @@ -476,8 +495,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF ELSE @@ -538,8 +561,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 K = K + 1 @@ -599,8 +626,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even @@ -668,8 +699,12 @@ * A(k-1,k-1) S = S + AA WORK( I ) = WORK( I ) + S - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK ( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 DO I = K, N - 1 @@ -737,8 +772,12 @@ END DO WORK( J-1 ) = WORK( J-1 ) + S END DO - I = ISAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. SISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF END IF diff --git a/SRC/slansp.f b/SRC/slansp.f index 359a0200..9ed3f46e 100644 --- a/SRC/slansp.f +++ b/SRC/slansp.f @@ -141,11 +141,11 @@ EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -160,7 +160,8 @@ K = 1 DO 20 J = 1, N DO 10 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -168,7 +169,8 @@ K = 1 DO 40 J = 1, N DO 30 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -193,7 +195,8 @@ K = K + 1 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -208,7 +211,7 @@ WORK( I ) = WORK( I ) + ABSA K = K + 1 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/slanst.f b/SRC/slanst.f index d25e096d..3a61850e 100644 --- a/SRC/slanst.f +++ b/SRC/slanst.f @@ -124,14 +124,14 @@ REAL ANORM, SCALE, SUM * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. External Subroutines .. EXTERNAL SLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -143,8 +143,10 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( E( I ) ) ) + SUM = ABS( D( I ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM + SUM = ABS( E( I ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR. $ LSAME( NORM, 'I' ) ) THEN @@ -154,11 +156,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ), - $ ABS( E( N-1 ) )+ABS( D( N ) ) ) + ANORM = ABS( D( 1 ) )+ABS( E( 1 ) ) + SUM = ABS( E( N-1 ) )+ABS( D( N ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( E( I ) )+ - $ ABS( E( I-1 ) ) ) + SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) ) + IF( ANORM .LT. SUM .OR. SISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/slansy.f b/SRC/slansy.f index 1caebf57..44c6691b 100644 --- a/SRC/slansy.f +++ b/SRC/slansy.f @@ -149,11 +149,11 @@ EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -167,13 +167,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, J - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -194,7 +196,8 @@ WORK( J ) = SUM + ABS( A( J, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -207,7 +210,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/slantb.f b/SRC/slantb.f index 777052f6..f1f79206 100644 --- a/SRC/slantb.f +++ b/SRC/slantb.f @@ -168,8 +168,8 @@ EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. INTRINSIC ABS, MAX, MIN, SQRT @@ -187,13 +187,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -202,13 +204,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -232,7 +236,7 @@ SUM = SUM + ABS( AB( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -247,7 +251,7 @@ SUM = SUM + ABS( AB( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -301,7 +305,8 @@ END IF END IF DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/slantp.f b/SRC/slantp.f index 4af9381a..59be89d0 100644 --- a/SRC/slantp.f +++ b/SRC/slantp.f @@ -152,11 +152,11 @@ EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -172,14 +172,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = K, K + J - 2 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = K + 1, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -189,14 +191,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -223,7 +227,7 @@ 100 CONTINUE END IF K = K + J - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -239,7 +243,7 @@ 130 CONTINUE END IF K = K + N - J + 1 - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -296,7 +300,8 @@ END IF VALUE = ZERO DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/slantr.f b/SRC/slantr.f index a25c2855..083dfd49 100644 --- a/SRC/slantr.f +++ b/SRC/slantr.f @@ -169,11 +169,11 @@ EXTERNAL SLASSQ * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, SISNAN + EXTERNAL LSAME, SISNAN * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -188,13 +188,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -203,13 +205,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -233,7 +237,7 @@ SUM = SUM + ABS( A( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -248,7 +252,7 @@ SUM = SUM + ABS( A( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -301,7 +305,8 @@ END IF VALUE = ZERO DO 280 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 280 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/zlangb.f b/SRC/zlangb.f index 2c06e0ba..eceea871 100644 --- a/SRC/zlangb.f +++ b/SRC/zlangb.f @@ -147,11 +147,11 @@ * .. * .. Local Scalars .. INTEGER I, J, K, L - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SCALE, SUM, VALUE, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ @@ -170,7 +170,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + TEMP = ABS( AB( I, J ) ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -183,7 +184,7 @@ DO 30 I = MAX( KU+2-J, 1 ), MIN( N+KU+1-J, KL+KU+1 ) SUM = SUM + ABS( AB( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -200,7 +201,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/zlange.f b/SRC/zlange.f index 4fcd0eed..56e0bc6d 100644 --- a/SRC/zlange.f +++ b/SRC/zlange.f @@ -137,17 +137,17 @@ * .. * .. Local Scalars .. INTEGER I, J - DOUBLE PRECISION SCALE, SUM, VALUE + DOUBLE PRECISION SCALE, SUM, VALUE, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -160,7 +160,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + TEMP = ABS( A( I, J ) ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -173,7 +174,7 @@ DO 30 I = 1, M SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE.LT.SUM .OR. DISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -189,7 +190,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + TEMP = WORK( I ) + IF( VALUE.LT.TEMP .OR. DISNAN( TEMP ) ) VALUE = TEMP 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/zlangt.f b/SRC/zlangt.f index db8fe571..94446075 100644 --- a/SRC/zlangt.f +++ b/SRC/zlangt.f @@ -127,17 +127,17 @@ * .. * .. Local Scalars .. INTEGER I - DOUBLE PRECISION ANORM, SCALE, SUM + DOUBLE PRECISION ANORM, SCALE, SUM, TEMP * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -149,9 +149,12 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( DL( I ) ) ) - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( DU( I ) ) ) + IF( ANORM.LT.ABS( DL( I ) ) .OR. DISNAN( ABS( DL( I ) ) ) ) + $ ANORM = ABS(DL(I)) + IF( ANORM.LT.ABS( D( I ) ) .OR. DISNAN( ABS( D( I ) ) ) ) + $ ANORM = ABS(D(I)) + IF( ANORM.LT.ABS( DU( I ) ) .OR. DISNAN (ABS( DU( I ) ) ) ) + $ ANORM = ABS(DU(I)) 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' ) THEN * @@ -160,11 +163,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DL( 1 ) ), - $ ABS( D( N ) )+ABS( DU( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DL( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DU( N-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DL( I ) )+ - $ ABS( DU( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DL( I ) )+ABS( DU( I-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP 20 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -174,11 +178,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( DU( 1 ) ), - $ ABS( D( N ) )+ABS( DL( N-1 ) ) ) + ANORM = ABS( D( 1 ) )+ABS( DU( 1 ) ) + TEMP = ABS( D( N ) )+ABS( DL( N-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP DO 30 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( DU( I ) )+ - $ ABS( DL( I-1 ) ) ) + TEMP = ABS( D( I ) )+ABS( DU( I ) )+ABS( DL( I-1 ) ) + IF( ANORM .LT. TEMP .OR. DISNAN( TEMP ) ) ANORM = TEMP 30 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlanhb.f b/SRC/zlanhb.f index 2c546542..e708e15e 100644 --- a/SRC/zlanhb.f +++ b/SRC/zlanhb.f @@ -157,8 +157,8 @@ DOUBLE PRECISION ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ @@ -178,15 +178,19 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE - VALUE = MAX( VALUE, ABS( DBLE( AB( K+1, J ) ) ) ) + SUM = ABS( DBLE( AB( K+1, J ) ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 20 CONTINUE ELSE DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( DBLE( AB( 1, J ) ) ) ) + SUM = ABS( DBLE( AB( 1, J ) ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM DO 30 I = 2, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -208,7 +212,8 @@ WORK( J ) = SUM + ABS( DBLE( AB( K+1, J ) ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -222,7 +227,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlanhe.f b/SRC/zlanhe.f index 5a5df2ea..04662ef3 100644 --- a/SRC/zlanhe.f +++ b/SRC/zlanhe.f @@ -149,14 +149,14 @@ DOUBLE PRECISION ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, MAX, SQRT + INTRINSIC ABS, DBLE, SQRT * .. * .. Executable Statements .. * @@ -170,15 +170,19 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, J - 1 - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE - VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) ) + SUM = ABS( DBLE( A( J, J ) ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 20 CONTINUE ELSE DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( DBLE( A( J, J ) ) ) ) + SUM = ABS( DBLE( A( J, J ) ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM DO 30 I = J + 1, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -199,7 +203,8 @@ WORK( J ) = SUM + ABS( DBLE( A( J, J ) ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -212,7 +217,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlanhf.f b/SRC/zlanhf.f index 7bef2cd3..8f48e889 100644 --- a/SRC/zlanhf.f +++ b/SRC/zlanhf.f @@ -268,18 +268,17 @@ * .. * .. Local Scalars .. INTEGER I, J, IFM, ILU, NOE, N1, K, L, LDA - DOUBLE PRECISION SCALE, S, VALUE, AA + DOUBLE PRECISION SCALE, S, VALUE, AA, TEMP * .. * .. External Functions .. - LOGICAL LSAME - INTEGER IDAMAX - EXTERNAL LSAME, IDAMAX + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, MAX, SQRT + INTRINSIC ABS, DBLE, SQRT * .. * .. Executable Statements .. * @@ -339,46 +338,70 @@ * uplo ='L' J = 0 * -> L(0,0) - VALUE = MAX( VALUE, ABS( DBLE( A( J+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( J+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = 1, K - 1 DO I = 0, J - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - 1 * L(k+j,k+j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = J * -> L(j,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 1, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 2 DO I = 0, K + J - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K + J - 1 * -> U(i,i) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = I + 1 * =k+j; i -> U(j,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = K + J + 1, N - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO DO I = 0, N - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP * j=k-1 END DO * i=n-1 -> U(n-1,n-1) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END IF ELSE * xpose case; A is k by n @@ -386,55 +409,83 @@ * uplo ='L' DO J = 0, K - 2 DO I = 0, J - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J * L(i,i) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = J + 1 * L(j+k,j+k) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 2, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K - 1 DO I = 0, K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K - 1 * -> L(i,i) is at A(i,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO J = K, N - 1 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 2 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K - 1 * -> U(j,j) is at A(0,j) - VALUE = MAX( VALUE, ABS( DBLE( A( 0+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( 0+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = K, N - 1 DO I = 0, J - K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - K * -> U(i,i) at A(i,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = J - K + 1 * U(j,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J - K + 2, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO END IF @@ -447,50 +498,78 @@ * uplo ='L' J = 0 * -> L(k,k) & j=1 -> L(0,0) - VALUE = MAX( VALUE, ABS( DBLE( A( J+J*LDA ) ) ) ) - VALUE = MAX( VALUE, ABS( DBLE( A( J+1+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( J+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + TEMP = ABS( DBLE( A( J+1+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 2, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = 1, K - 1 DO I = 0, J - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J * L(k+j,k+j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = J + 1 * -> L(j,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 2, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 2 DO I = 0, K + J - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K + J * -> U(i,i) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = I + 1 * =k+j+1; i -> U(j,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = K + J + 2, N - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO DO I = 0, N - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP * j=k-1 END DO * i=n-1 -> U(n-1,n-1) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = N * -> U(k-1,k-1) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END IF ELSE * xpose case; A is k by n+1 @@ -498,70 +577,106 @@ * uplo ='L' J = 0 * -> L(k,k) at A(0,0) - VALUE = MAX( VALUE, ABS( DBLE( A( J+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( J+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = 1, K - 1 DO I = 0, J - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - 1 * L(i,i) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = J * L(j+k,j+k) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J + 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K DO I = 0, K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K - 1 * -> L(i,i) is at A(i,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO J = K + 1, N DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO ELSE * uplo = 'U' DO J = 0, K - 1 DO I = 0, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = K * -> U(j,j) is at A(0,j) - VALUE = MAX( VALUE, ABS( DBLE( A( 0+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( 0+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO DO J = K + 1, N - 1 DO I = 0, J - K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = J - K - 1 * -> U(i,i) at A(i,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP I = J - K * U(j,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP DO I = J - K + 1, K - 1 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO END DO J = N DO I = 0, K - 2 - VALUE = MAX( VALUE, ABS( A( I+J*LDA ) ) ) + TEMP = ABS( A( I+J*LDA ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END DO I = K - 1 * U(k,k) at A(i,j) - VALUE = MAX( VALUE, ABS( DBLE( A( I+J*LDA ) ) ) ) + TEMP = ABS( DBLE( A( I+J*LDA ) ) ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP END IF END IF END IF @@ -608,8 +723,12 @@ WORK( J ) = WORK( J ) + S END DO 10 CONTINUE - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 & uplo = 'L' K = K + 1 @@ -646,8 +765,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even & A is n+1 by k = n/2 @@ -681,8 +804,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu = 1 & uplo = 'L' DO I = K, N - 1 @@ -715,8 +842,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF ELSE @@ -778,8 +909,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 & uplo = 'L' K = K + 1 @@ -839,8 +974,12 @@ END DO WORK( J ) = WORK( J ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF ELSE * n is even & A is k=n/2 by n+1 @@ -909,8 +1048,12 @@ * A(k-1,k-1) S = S + AA WORK( I ) = WORK( I ) + S - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO ELSE * ilu=1 & uplo = 'L' DO I = K, N - 1 @@ -980,8 +1123,12 @@ END DO WORK( J-1 ) = WORK( J-1 ) + S END DO - I = IDAMAX( N, WORK, 1 ) - VALUE = WORK( I-1 ) + VALUE = WORK( 0 ) + DO I = 1, N-1 + TEMP = WORK( I ) + IF( VALUE .LT. TEMP .OR. DISNAN( TEMP ) ) + $ VALUE = TEMP + END DO END IF END IF END IF diff --git a/SRC/zlanhp.f b/SRC/zlanhp.f index cf36cad0..496e04c7 100644 --- a/SRC/zlanhp.f +++ b/SRC/zlanhp.f @@ -142,14 +142,14 @@ DOUBLE PRECISION ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, MAX, SQRT + INTRINSIC ABS, DBLE, SQRT * .. * .. Executable Statements .. * @@ -164,17 +164,21 @@ K = 0 DO 20 J = 1, N DO 10 I = K + 1, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J - VALUE = MAX( VALUE, ABS( DBLE( AP( K ) ) ) ) + SUM = ABS( DBLE( AP( K ) ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 20 CONTINUE ELSE K = 1 DO 40 J = 1, N - VALUE = MAX( VALUE, ABS( DBLE( AP( K ) ) ) ) + SUM = ABS( DBLE( AP( K ) ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM DO 30 I = K + 1, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -199,7 +203,8 @@ K = K + 1 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -214,7 +219,7 @@ WORK( I ) = WORK( I ) + ABSA K = K + 1 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlanhs.f b/SRC/zlanhs.f index f14932d2..7e255ca1 100644 --- a/SRC/zlanhs.f +++ b/SRC/zlanhs.f @@ -134,14 +134,14 @@ DOUBLE PRECISION SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -154,7 +154,8 @@ VALUE = ZERO DO 20 J = 1, N DO 10 I = 1, MIN( N, J+1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE IF( ( LSAME( NORM, 'O' ) ) .OR. ( NORM.EQ.'1' ) ) THEN @@ -167,7 +168,7 @@ DO 30 I = 1, MIN( N, J+1 ) SUM = SUM + ABS( A( I, J ) ) 30 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 40 CONTINUE ELSE IF( LSAME( NORM, 'I' ) ) THEN * @@ -183,7 +184,8 @@ 70 CONTINUE VALUE = ZERO DO 80 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 80 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/zlanht.f b/SRC/zlanht.f index cc57b7bc..545221d0 100644 --- a/SRC/zlanht.f +++ b/SRC/zlanht.f @@ -126,8 +126,8 @@ DOUBLE PRECISION ANORM, SCALE, SUM * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL DLASSQ, ZLASSQ @@ -145,8 +145,10 @@ * ANORM = ABS( D( N ) ) DO 10 I = 1, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) ) ) - ANORM = MAX( ANORM, ABS( E( I ) ) ) + SUM = ABS( D( I ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM + SUM = ABS( E( I ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM 10 CONTINUE ELSE IF( LSAME( NORM, 'O' ) .OR. NORM.EQ.'1' .OR. $ LSAME( NORM, 'I' ) ) THEN @@ -156,11 +158,12 @@ IF( N.EQ.1 ) THEN ANORM = ABS( D( 1 ) ) ELSE - ANORM = MAX( ABS( D( 1 ) )+ABS( E( 1 ) ), - $ ABS( E( N-1 ) )+ABS( D( N ) ) ) + ANORM = ABS( D( 1 ) )+ABS( E( 1 ) ) + SUM = ABS( E( N-1 ) )+ABS( D( N ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM DO 20 I = 2, N - 1 - ANORM = MAX( ANORM, ABS( D( I ) )+ABS( E( I ) )+ - $ ABS( E( I-1 ) ) ) + SUM = ABS( D( I ) )+ABS( E( I ) )+ABS( E( I-1 ) ) + IF( ANORM .LT. SUM .OR. DISNAN( SUM ) ) ANORM = SUM 20 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlansb.f b/SRC/zlansb.f index e6f05abd..5a48b535 100644 --- a/SRC/zlansb.f +++ b/SRC/zlansb.f @@ -155,8 +155,8 @@ DOUBLE PRECISION ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ @@ -176,13 +176,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -204,7 +206,8 @@ WORK( J ) = SUM + ABS( AB( K+1, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -218,7 +221,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlansp.f b/SRC/zlansp.f index 7f49476a..f02a8d10 100644 --- a/SRC/zlansp.f +++ b/SRC/zlansp.f @@ -140,14 +140,14 @@ DOUBLE PRECISION ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, DBLE, DIMAG, MAX, SQRT + INTRINSIC ABS, DBLE, DIMAG, SQRT * .. * .. Executable Statements .. * @@ -162,7 +162,8 @@ K = 1 DO 20 J = 1, N DO 10 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE @@ -170,7 +171,8 @@ K = 1 DO 40 J = 1, N DO 30 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -195,7 +197,8 @@ K = K + 1 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -210,7 +213,7 @@ WORK( I ) = WORK( I ) + ABSA K = K + 1 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlansy.f b/SRC/zlansy.f index 28263cf7..ed8ecccf 100644 --- a/SRC/zlansy.f +++ b/SRC/zlansy.f @@ -148,14 +148,14 @@ DOUBLE PRECISION ABSA, SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -169,13 +169,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, J - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J, N - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -196,7 +198,8 @@ WORK( J ) = SUM + ABS( A( J, J ) ) 60 CONTINUE DO 70 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE ELSE DO 80 I = 1, N @@ -209,7 +212,7 @@ SUM = SUM + ABSA WORK( I ) = WORK( I ) + ABSA 90 CONTINUE - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 100 CONTINUE END IF ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN diff --git a/SRC/zlantb.f b/SRC/zlantb.f index 4e66c643..0dd04f5e 100644 --- a/SRC/zlantb.f +++ b/SRC/zlantb.f @@ -167,8 +167,8 @@ DOUBLE PRECISION SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ @@ -189,13 +189,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = MAX( K+2-J, 1 ), K - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = 2, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -204,13 +206,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = MAX( K+2-J, 1 ), K + 1 - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = 1, MIN( N+1-J, K+1 ) - VALUE = MAX( VALUE, ABS( AB( I, J ) ) ) + SUM = ABS( AB( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -234,7 +238,7 @@ SUM = SUM + ABS( AB( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -249,7 +253,7 @@ SUM = SUM + ABS( AB( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -303,7 +307,8 @@ END IF END IF DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/zlantp.f b/SRC/zlantp.f index 7e38e9ce..36e3f9f1 100644 --- a/SRC/zlantp.f +++ b/SRC/zlantp.f @@ -151,14 +151,14 @@ DOUBLE PRECISION SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, SQRT + INTRINSIC ABS, SQRT * .. * .. Executable Statements .. * @@ -174,14 +174,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = K, K + J - 2 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE K = K + J 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = K + 1, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE K = K + N - J + 1 40 CONTINUE @@ -191,14 +193,16 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = K, K + J - 1 - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE K = K + J 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = K, K + N - J - VALUE = MAX( VALUE, ABS( AP( I ) ) ) + SUM = ABS( AP( I ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE K = K + N - J + 1 80 CONTINUE @@ -225,7 +229,7 @@ 100 CONTINUE END IF K = K + J - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -241,7 +245,7 @@ 130 CONTINUE END IF K = K + N - J + 1 - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -298,7 +302,8 @@ END IF VALUE = ZERO DO 270 I = 1, N - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 270 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * diff --git a/SRC/zlantr.f b/SRC/zlantr.f index 9253b954..6c9fd7a0 100644 --- a/SRC/zlantr.f +++ b/SRC/zlantr.f @@ -168,14 +168,14 @@ DOUBLE PRECISION SCALE, SUM, VALUE * .. * .. External Functions .. - LOGICAL LSAME - EXTERNAL LSAME + LOGICAL LSAME, DISNAN + EXTERNAL LSAME, DISNAN * .. * .. External Subroutines .. EXTERNAL ZLASSQ * .. * .. Intrinsic Functions .. - INTRINSIC ABS, MAX, MIN, SQRT + INTRINSIC ABS, MIN, SQRT * .. * .. Executable Statements .. * @@ -190,13 +190,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE DO 40 J = 1, N DO 30 I = J + 1, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -205,13 +207,15 @@ IF( LSAME( UPLO, 'U' ) ) THEN DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE DO 80 J = 1, N DO 70 I = J, M - VALUE = MAX( VALUE, ABS( A( I, J ) ) ) + SUM = ABS( A( I, J ) ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -235,7 +239,7 @@ SUM = SUM + ABS( A( I, J ) ) 100 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE DO 140 J = 1, N @@ -250,7 +254,7 @@ SUM = SUM + ABS( A( I, J ) ) 130 CONTINUE END IF - VALUE = MAX( VALUE, SUM ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 140 CONTINUE END IF ELSE IF( LSAME( NORM, 'I' ) ) THEN @@ -303,7 +307,8 @@ END IF VALUE = ZERO DO 280 I = 1, M - VALUE = MAX( VALUE, WORK( I ) ) + SUM = WORK( I ) + IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 280 CONTINUE ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN * |