xGGQRCS: ensure leading dimension is at least one

Ensure the leading dimension of the assembled matrix `G = [A; B]` is always at least one.
Reference-LAPACK · Apr 22, 2021 · 8a0bef1 · 8a0bef1
1 parent e805767
commit 8a0bef1
Show file tree

Hide file tree

Showing 4 changed files with 8 additions and 4 deletions.
diff --git a/SRC/cggqrcs.f b/SRC/cggqrcs.f
@@ -452,7 +452,8 @@ RECURSIVE SUBROUTINE CGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
 *
       SWAPPED = .FALSE.
       L = 0
-      LDG = M + P
+*     The leading dimension must never be zero
+      LDG = MAX( M + P, 1 )
       LDVT = N
       LMAX = MIN( M + P, N )
       IG = 1

diff --git a/SRC/dggqrcs.f b/SRC/dggqrcs.f
@@ -426,7 +426,8 @@ RECURSIVE SUBROUTINE DGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
 *
       SWAPPED = .FALSE.
       L = 0
-      LDG = M + P
+*     The leading dimension must never be zero
+      LDG = MAX( M + P, 1 )
       LDVT = N
       LMAX = MIN( M + P, N )
       IG = 1

diff --git a/SRC/sggqrcs.f b/SRC/sggqrcs.f
@@ -426,7 +426,8 @@ RECURSIVE SUBROUTINE SGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
 *
       SWAPPED = .FALSE.
       L = 0
-      LDG = M + P
+*     The leading dimension must never be zero
+      LDG = MAX( M + P, 1 )
       LDVT = N
       LMAX = MIN( M + P, N )
       IG = 1

diff --git a/SRC/zggqrcs.f b/SRC/zggqrcs.f
@@ -451,7 +451,8 @@ RECURSIVE SUBROUTINE ZGGQRCS( JOBU1, JOBU2, JOBX, M, N, P, L,
 *
       SWAPPED = .FALSE.
       L = 0
-      LDG = M + P
+*     The leading dimension must never be zero
+      LDG = MAX( M + P, 1 )
       LDVT = N
       LMAX = MIN( M + P, N )
       IG = 1