diff options
Diffstat (limited to 'SRC/zlantp.f')
-rw-r--r-- | SRC/zlantp.f | 25 |
1 files changed, 15 insertions, 10 deletions
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 * |