fixes in cungtsqr_row.f, dorgtsqr_row.f, sorgtsqr_row.f, zungtsqr_row.f for bug #481 (FFLAGS = -O0 -frecursive -ggdb3 -fcheck=bounds

The TSQR tests fail, array index out of bounds)

Author: scr2016

SRC/cungtsqr_row.f

@@ -214,6 +214,9 @@ SUBROUTINE CUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
      $                   LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
      $                   KB, KB_LAST, KNB, MB1
 *     ..
+*     .. Local Arrays ..
+      COMPLEX            DUMMY( 1, 1 )
+*     ..
 *     .. External Subroutines ..
       EXTERNAL           CLARFB_GETT, CLASET, XERBLA
 *     ..
@@ -354,9 +357,21 @@ SUBROUTINE CUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
 *
          KNB = MIN( NBLOCAL, N - KB + 1 )
 *
-         CALL CLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
-     $               T( 1, KB ), LDT, A( KB, KB ), LDA,
-     $               A( KB+KNB, KB), LDA, WORK, KNB )
+         IF( MB1-KB-KNB+1.EQ.0 ) THEN
+*
+*           In SLARFB_GETT parameters, when M=0, then the matrix B
+*           does not exist, hence we need to pass a dummy array
+*           reference DUMMY(1,1) to B with LDDUMMY=1.
+*
+            CALL CLARFB_GETT( 'N', 0, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        DUMMY( 1, 1 ), 1, WORK, KNB )
+         ELSE
+            CALL CLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        A( KB+KNB, KB), LDA, WORK, KNB )
+
+         END IF
 *
       END DO
 *

SRC/dorgtsqr_row.f

@@ -213,6 +213,9 @@ SUBROUTINE DORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
      $                   LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
      $                   KB, KB_LAST, KNB, MB1
 *     ..
+*     .. Local Arrays ..
+      DOUBLE PRECISION   DUMMY( 1, 1 )
+*     ..
 *     .. External Subroutines ..
       EXTERNAL           DLARFB_GETT, DLASET, XERBLA
 *     ..
@@ -353,9 +356,21 @@ SUBROUTINE DORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
 *
          KNB = MIN( NBLOCAL, N - KB + 1 )
 *
-         CALL DLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
-     $               T( 1, KB ), LDT, A( KB, KB ), LDA,
-     $               A( KB+KNB, KB), LDA, WORK, KNB )
+         IF( MB1-KB-KNB+1.EQ.0 ) THEN
+*
+*           In SLARFB_GETT parameters, when M=0, then the matrix B
+*           does not exist, hence we need to pass a dummy array
+*           reference DUMMY(1,1) to B with LDDUMMY=1.
+*
+            CALL DLARFB_GETT( 'N', 0, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        DUMMY( 1, 1 ), 1, WORK, KNB )
+         ELSE
+            CALL DLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        A( KB+KNB, KB), LDA, WORK, KNB )
+
+         END IF
 *
       END DO
 *

SRC/sorgtsqr_row.f

@@ -213,6 +213,9 @@ SUBROUTINE SORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
      $                   LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
      $                   KB, KB_LAST, KNB, MB1
 *     ..
+*     .. Local Arrays ..
+      REAL               DUMMY( 1, 1 )
+*     ..
 *     .. External Subroutines ..
       EXTERNAL           SLARFB_GETT, SLASET, XERBLA
 *     ..
@@ -353,9 +356,21 @@ SUBROUTINE SORGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
 *
          KNB = MIN( NBLOCAL, N - KB + 1 )
 *
-         CALL SLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
-     $               T( 1, KB ), LDT, A( KB, KB ), LDA,
-     $               A( KB+KNB, KB), LDA, WORK, KNB )
+         IF( MB1-KB-KNB+1.EQ.0 ) THEN
+*
+*           In SLARFB_GETT parameters, when M=0, then the matrix B
+*           does not exist, hence we need to pass a dummy array
+*           reference DUMMY(1,1) to B with LDDUMMY=1.
+*
+            CALL SLARFB_GETT( 'N', 0, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        DUMMY( 1, 1 ), 1, WORK, KNB )
+         ELSE
+            CALL SLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        A( KB+KNB, KB), LDA, WORK, KNB )
+
+         END IF
 *
       END DO
 *

SRC/zungtsqr_row.f

@@ -214,6 +214,9 @@ SUBROUTINE ZUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
      $                   LWORKOPT, NUM_ALL_ROW_BLOCKS, JB_T, IB, IMB,
      $                   KB, KB_LAST, KNB, MB1
 *     ..
+*     .. Local Arrays ..
+      COMPLEX*16         DUMMY( 1, 1 )
+*     ..
 *     .. External Subroutines ..
       EXTERNAL           ZLARFB_GETT, ZLASET, XERBLA
 *     ..
@@ -354,9 +357,21 @@ SUBROUTINE ZUNGTSQR_ROW( M, N, MB, NB, A, LDA, T, LDT, WORK,
 *
          KNB = MIN( NBLOCAL, N - KB + 1 )
 *
-         CALL ZLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
-     $               T( 1, KB ), LDT, A( KB, KB ), LDA,
-     $               A( KB+KNB, KB), LDA, WORK, KNB )
+         IF( MB1-KB-KNB+1.EQ.0 ) THEN
+*
+*           In SLARFB_GETT parameters, when M=0, then the matrix B
+*           does not exist, hence we need to pass a dummy array
+*           reference DUMMY(1,1) to B with LDDUMMY=1.
+*
+            CALL ZLARFB_GETT( 'N', 0, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        DUMMY( 1, 1 ), 1, WORK, KNB )
+         ELSE
+            CALL ZLARFB_GETT( 'N', MB1-KB-KNB+1, N-KB+1, KNB,
+     $                        T( 1, KB ), LDT, A( KB, KB ), LDA,
+     $                        A( KB+KNB, KB), LDA, WORK, KNB )
+
+         END IF
 *
       END DO
 *