diff --git a/lapack-netlib/SRC/clacpy.f b/lapack-netlib/SRC/clacpy.f index ab4404a29a..0e1a88e70a 100644 --- a/lapack-netlib/SRC/clacpy.f +++ b/lapack-netlib/SRC/clacpy.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CLACPY + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -96,10 +94,11 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complexOTHERauxiliary +*> \ingroup lacpy * * ===================================================================== SUBROUTINE CLACPY( UPLO, M, N, A, LDA, B, LDB ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -135,7 +134,7 @@ SUBROUTINE CLACPY( UPLO, M, N, A, LDA, B, LDB ) 20 CONTINUE * ELSE IF( LSAME( UPLO, 'L' ) ) THEN - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J, M B( I, J ) = A( I, J ) 30 CONTINUE diff --git a/lapack-netlib/SRC/clantr.f b/lapack-netlib/SRC/clantr.f index f1dce1402d..a671f60a2f 100644 --- a/lapack-netlib/SRC/clantr.f +++ b/lapack-netlib/SRC/clantr.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CLANTR + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -134,11 +132,13 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complexOTHERauxiliary +*> \ingroup lantr * * ===================================================================== - REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -188,14 +188,16 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -205,14 +207,16 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE - DO 80 J = 1, N + DO 80 J = 1, MIN( M, N ) DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -239,7 +243,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE - DO 140 J = 1, N + DO 140 J = 1, MIN( M, N ) IF( UDIAG ) THEN SUM = ONE DO 120 I = J + 1, M @@ -286,7 +290,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 220 I = N + 1, M WORK( I ) = ZERO 220 CONTINUE - DO 240 J = 1, N + DO 240 J = 1, MIN( M, N ) DO 230 I = J + 1, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 230 CONTINUE @@ -295,7 +299,7 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 250 I = 1, M WORK( I ) = ZERO 250 CONTINUE - DO 270 J = 1, N + DO 270 J = 1, MIN( M, N ) DO 260 I = J, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 260 CONTINUE @@ -307,36 +311,39 @@ REAL FUNCTION CLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) + SUM = REAL( MIN( M, N ) ) DO 290 J = 2, N - CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL CLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL CLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) - DO 310 J = 1, N + SUM = REAL( MIN( M, N ) ) + DO 310 J = 1, MIN( M, N ) CALL CLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, $ SUM ) 310 CONTINUE ELSE SCALE = ZERO SUM = ONE - DO 320 J = 1, N + DO 320 J = 1, MIN( M, N ) CALL CLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) 320 CONTINUE END IF diff --git a/lapack-netlib/SRC/clascl.f b/lapack-netlib/SRC/clascl.f index f9aace0bc4..33716bf758 100644 --- a/lapack-netlib/SRC/clascl.f +++ b/lapack-netlib/SRC/clascl.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CLASCL + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -136,10 +134,12 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complexOTHERauxiliary +*> \ingroup lascl * * ===================================================================== - SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -291,7 +291,7 @@ SUBROUTINE CLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * * Lower triangular matrix * - DO 50 J = 1, N + DO 50 J = 1, MIN( M, N ) DO 40 I = J, M A( I, J ) = A( I, J )*MUL 40 CONTINUE diff --git a/lapack-netlib/SRC/dlacpy.f b/lapack-netlib/SRC/dlacpy.f index 917aa1e2a2..ae8cc7aa6b 100644 --- a/lapack-netlib/SRC/dlacpy.f +++ b/lapack-netlib/SRC/dlacpy.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DLACPY + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -96,10 +94,11 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup OTHERauxiliary +*> \ingroup lacpy * * ===================================================================== SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -134,7 +133,7 @@ SUBROUTINE DLACPY( UPLO, M, N, A, LDA, B, LDB ) 10 CONTINUE 20 CONTINUE ELSE IF( LSAME( UPLO, 'L' ) ) THEN - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J, M B( I, J ) = A( I, J ) 30 CONTINUE diff --git a/lapack-netlib/SRC/dlantr.f b/lapack-netlib/SRC/dlantr.f index 9b68f19755..69804b52b0 100644 --- a/lapack-netlib/SRC/dlantr.f +++ b/lapack-netlib/SRC/dlantr.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DLANTR + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -133,11 +131,13 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup doubleOTHERauxiliary +*> \ingroup lantr * * ===================================================================== - DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -186,14 +186,16 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -203,14 +205,16 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE - DO 80 J = 1, N + DO 80 J = 1, MIN( M, N ) DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -237,7 +241,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE - DO 140 J = 1, N + DO 140 J = 1, MIN( M, N ) IF( UDIAG ) THEN SUM = ONE DO 120 I = J + 1, M @@ -284,7 +288,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 220 I = N + 1, M WORK( I ) = ZERO 220 CONTINUE - DO 240 J = 1, N + DO 240 J = 1, MIN (M, N ) DO 230 I = J + 1, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 230 CONTINUE @@ -293,7 +297,7 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 250 I = 1, M WORK( I ) = ZERO 250 CONTINUE - DO 270 J = 1, N + DO 270 J = 1, MIN( M, N ) DO 260 I = J, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 260 CONTINUE @@ -305,7 +309,8 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -314,27 +319,29 @@ DOUBLE PRECISION FUNCTION DLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SCALE = ONE SUM = MIN( M, N ) DO 290 J = 2, N - CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL DLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL DLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE SUM = MIN( M, N ) - DO 310 J = 1, N + DO 310 J = 1, MIN( M, N ) CALL DLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, $ SUM ) 310 CONTINUE ELSE SCALE = ZERO SUM = ONE - DO 320 J = 1, N + DO 320 J = 1, MIN( M, N ) CALL DLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) 320 CONTINUE END IF diff --git a/lapack-netlib/SRC/dlascl.f b/lapack-netlib/SRC/dlascl.f index 0a4bf21ce1..5db6fc40b8 100644 --- a/lapack-netlib/SRC/dlascl.f +++ b/lapack-netlib/SRC/dlascl.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DLASCL + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -136,10 +134,12 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup OTHERauxiliary +*> \ingroup lascl * * ===================================================================== - SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -291,7 +291,7 @@ SUBROUTINE DLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * * Lower triangular matrix * - DO 50 J = 1, N + DO 50 J = 1, MIN( M, N ) DO 40 I = J, M A( I, J ) = A( I, J )*MUL 40 CONTINUE diff --git a/lapack-netlib/SRC/slacpy.f b/lapack-netlib/SRC/slacpy.f index a33a3c67b7..8214332dc4 100644 --- a/lapack-netlib/SRC/slacpy.f +++ b/lapack-netlib/SRC/slacpy.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download SLACPY + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -96,10 +94,11 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup OTHERauxiliary +*> \ingroup lacpy * * ===================================================================== SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -134,7 +133,7 @@ SUBROUTINE SLACPY( UPLO, M, N, A, LDA, B, LDB ) 10 CONTINUE 20 CONTINUE ELSE IF( LSAME( UPLO, 'L' ) ) THEN - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J, M B( I, J ) = A( I, J ) 30 CONTINUE diff --git a/lapack-netlib/SRC/slantr.f b/lapack-netlib/SRC/slantr.f index 384f58550b..b27b3b671d 100644 --- a/lapack-netlib/SRC/slantr.f +++ b/lapack-netlib/SRC/slantr.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download SLANTR + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -133,11 +131,13 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup realOTHERauxiliary +*> \ingroup lantr * * ===================================================================== - REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -186,14 +186,16 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -203,14 +205,16 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE - DO 80 J = 1, N + DO 80 J = 1, MIN( M, N ) DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ SISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -237,7 +241,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE - DO 140 J = 1, N + DO 140 J = 1, MIN( M, N ) IF( UDIAG ) THEN SUM = ONE DO 120 I = J + 1, M @@ -284,7 +288,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 220 I = N + 1, M WORK( I ) = ZERO 220 CONTINUE - DO 240 J = 1, N + DO 240 J = 1, MIN( M, N ) DO 230 I = J + 1, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 230 CONTINUE @@ -293,7 +297,7 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 250 I = 1, M WORK( I ) = ZERO 250 CONTINUE - DO 270 J = 1, N + DO 270 J = 1, MIN( M, N ) DO 260 I = J, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 260 CONTINUE @@ -305,36 +309,39 @@ REAL FUNCTION SLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. SISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * IF( LSAME( UPLO, 'U' ) ) THEN IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) + SUM = REAL( MIN( M, N ) ) DO 290 J = 2, N - CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL SLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL SLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE - SUM = MIN( M, N ) - DO 310 J = 1, N + SUM = REAL( MIN( M, N ) ) + DO 310 J = 1, MIN ( M, N ) CALL SLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, $ SUM ) 310 CONTINUE ELSE SCALE = ZERO SUM = ONE - DO 320 J = 1, N + DO 320 J = 1, MIN( M, N ) CALL SLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) 320 CONTINUE END IF diff --git a/lapack-netlib/SRC/slascl.f b/lapack-netlib/SRC/slascl.f index 28cbd6514b..84b6010227 100644 --- a/lapack-netlib/SRC/slascl.f +++ b/lapack-netlib/SRC/slascl.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download SLASCL + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -136,10 +134,12 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup OTHERauxiliary +*> \ingroup lascl * * ===================================================================== - SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -291,7 +291,7 @@ SUBROUTINE SLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * * Lower triangular matrix * - DO 50 J = 1, N + DO 50 J = 1, MIN( M, N ) DO 40 I = J, M A( I, J ) = A( I, J )*MUL 40 CONTINUE diff --git a/lapack-netlib/SRC/zlacpy.f b/lapack-netlib/SRC/zlacpy.f index 06017509e0..3345530464 100644 --- a/lapack-netlib/SRC/zlacpy.f +++ b/lapack-netlib/SRC/zlacpy.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZLACPY + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -96,10 +94,11 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHERauxiliary +*> \ingroup lacpy * * ===================================================================== SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -135,7 +134,7 @@ SUBROUTINE ZLACPY( UPLO, M, N, A, LDA, B, LDB ) 20 CONTINUE * ELSE IF( LSAME( UPLO, 'L' ) ) THEN - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J, M B( I, J ) = A( I, J ) 30 CONTINUE diff --git a/lapack-netlib/SRC/zlantr.f b/lapack-netlib/SRC/zlantr.f index bd4b5da7c2..73a7bc621e 100644 --- a/lapack-netlib/SRC/zlantr.f +++ b/lapack-netlib/SRC/zlantr.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZLANTR + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -134,11 +132,13 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHERauxiliary +*> \ingroup lantr * * ===================================================================== - DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, + DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, + $ LDA, $ WORK ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -188,14 +188,16 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 20 J = 1, N DO 10 I = 1, MIN( M, J-1 ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 10 CONTINUE 20 CONTINUE ELSE - DO 40 J = 1, N + DO 40 J = 1, MIN( M, N ) DO 30 I = J + 1, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 30 CONTINUE 40 CONTINUE END IF @@ -205,14 +207,16 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 60 J = 1, N DO 50 I = 1, MIN( M, J ) SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 50 CONTINUE 60 CONTINUE ELSE - DO 80 J = 1, N + DO 80 J = 1, MIN( M, N ) DO 70 I = J, M SUM = ABS( A( I, J ) ) - IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM + IF( VALUE .LT. SUM .OR. + $ DISNAN( SUM ) ) VALUE = SUM 70 CONTINUE 80 CONTINUE END IF @@ -239,7 +243,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 110 CONTINUE ELSE - DO 140 J = 1, N + DO 140 J = 1, MIN( M, N ) IF( UDIAG ) THEN SUM = ONE DO 120 I = J + 1, M @@ -286,7 +290,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 220 I = N + 1, M WORK( I ) = ZERO 220 CONTINUE - DO 240 J = 1, N + DO 240 J = 1, MIN( M, N ) DO 230 I = J + 1, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 230 CONTINUE @@ -295,7 +299,7 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, DO 250 I = 1, M WORK( I ) = ZERO 250 CONTINUE - DO 270 J = 1, N + DO 270 J = 1, MIN( M, N ) DO 260 I = J, M WORK( I ) = WORK( I ) + ABS( A( I, J ) ) 260 CONTINUE @@ -307,7 +311,8 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SUM = WORK( I ) IF( VALUE .LT. SUM .OR. DISNAN( SUM ) ) VALUE = SUM 280 CONTINUE - ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. ( LSAME( NORM, 'E' ) ) ) THEN + ELSE IF( ( LSAME( NORM, 'F' ) ) .OR. + $ ( LSAME( NORM, 'E' ) ) ) THEN * * Find normF(A). * @@ -316,27 +321,29 @@ DOUBLE PRECISION FUNCTION ZLANTR( NORM, UPLO, DIAG, M, N, A, LDA, SCALE = ONE SUM = MIN( M, N ) DO 290 J = 2, N - CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, SUM ) + CALL ZLASSQ( MIN( M, J-1 ), A( 1, J ), 1, SCALE, + $ SUM ) 290 CONTINUE ELSE SCALE = ZERO SUM = ONE DO 300 J = 1, N - CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, SUM ) + CALL ZLASSQ( MIN( M, J ), A( 1, J ), 1, SCALE, + $ SUM ) 300 CONTINUE END IF ELSE IF( LSAME( DIAG, 'U' ) ) THEN SCALE = ONE SUM = MIN( M, N ) - DO 310 J = 1, N + DO 310 J = 1, MIN( M, N ) CALL ZLASSQ( M-J, A( MIN( M, J+1 ), J ), 1, SCALE, $ SUM ) 310 CONTINUE ELSE SCALE = ZERO SUM = ONE - DO 320 J = 1, N + DO 320 J = 1, MIN( M, N ) CALL ZLASSQ( M-J+1, A( J, J ), 1, SCALE, SUM ) 320 CONTINUE END IF diff --git a/lapack-netlib/SRC/zlascl.f b/lapack-netlib/SRC/zlascl.f index 4cce5ff5e0..a1262f1adb 100644 --- a/lapack-netlib/SRC/zlascl.f +++ b/lapack-netlib/SRC/zlascl.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZLASCL + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -136,10 +134,12 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHERauxiliary +*> \ingroup lascl * * ===================================================================== - SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) + SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, + $ INFO ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -291,7 +291,7 @@ SUBROUTINE ZLASCL( TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO ) * * Lower triangular matrix * - DO 50 J = 1, N + DO 50 J = 1, MIN( M, N ) DO 40 I = J, M A( I, J ) = A( I, J )*MUL 40 CONTINUE