Merge pull request #5766 from martin-frbg/lapack1251

Optimize ?LACPY/?LASCL/?LANTR looping in fat matrix cases with UPLO=L (Reference-LAPACK PR 1251)

Author: martin-frbg

lapack-netlib/SRC/clacpy.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CLACPY + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clacpy.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clacpy.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clacpy.f">
 *> [TXT]</a>
-*> \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

lapack-netlib/SRC/clantr.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CLANTR + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clantr.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clantr.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clantr.f">
 *> [TXT]</a>
-*> \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

lapack-netlib/SRC/clascl.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download CLASCL + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clascl.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clascl.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clascl.f">
 *> [TXT]</a>
-*> \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

lapack-netlib/SRC/dlacpy.f

@@ -5,15 +5,13 @@
 * Online html documentation available at
 *            http://www.netlib.org/lapack/explore-html/
 *
-*> \htmlonly
 *> Download DLACPY + dependencies
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlacpy.f">
 *> [TGZ]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlacpy.f">
 *> [ZIP]</a>
 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlacpy.f">
 *> [TXT]</a>
-*> \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