Merge pull request #5723 from martin-frbg/lapack1094

martin-frbg · web-flow · commit e48625414fd2 · 2026-03-31T12:16:09.000+02:00
Change WORK dimension in deprecated ?GELQS/?GEQRS (Reference-LAPACK PR 1094)
diff --git a/lapack-netlib/SRC/DEPRECATED/cgelqs.f b/lapack-netlib/SRC/DEPRECATED/cgelqs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE CGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
diff --git a/lapack-netlib/SRC/DEPRECATED/cgeqrs.f b/lapack-netlib/SRC/DEPRECATED/cgeqrs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE CGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       COMPLEX            A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
diff --git a/lapack-netlib/SRC/DEPRECATED/dgelqs.f b/lapack-netlib/SRC/DEPRECATED/dgelqs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE DGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
@@ -174,18 +174,19 @@ SUBROUTINE DGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *
 *     Solve L*X = B(1:m,:)
 *
-      CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
-     $            ONE, A, LDA, B, LDB )
+      CALL DTRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M,
+     $            NRHS, ONE, A, LDA, B, LDB )
 *
 *     Set B(m+1:n,:) to zero
 *
       IF( M.LT.N )
-     $   CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
+     $   CALL DLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ),
+     $                LDB )
 *
 *     B := Q' * B
 *
-      CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB,
-     $             WORK, LWORK, INFO )
+      CALL DORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B,
+     $             LDB, WORK, LWORK, INFO )
 *
       RETURN
 *
diff --git a/lapack-netlib/SRC/DEPRECATED/dgeqrs.f b/lapack-netlib/SRC/DEPRECATED/dgeqrs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE DGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       DOUBLE PRECISION   A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
diff --git a/lapack-netlib/SRC/DEPRECATED/sgelqs.f b/lapack-netlib/SRC/DEPRECATED/sgelqs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       REAL               A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE SGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       REAL               A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
@@ -174,18 +174,19 @@ SUBROUTINE SGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *
 *     Solve L*X = B(1:m,:)
 *
-      CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M, NRHS,
-     $            ONE, A, LDA, B, LDB )
+      CALL STRSM( 'Left', 'Lower', 'No transpose', 'Non-unit', M,
+     $            NRHS, ONE, A, LDA, B, LDB )
 *
 *     Set B(m+1:n,:) to zero
 *
       IF( M.LT.N )
-     $   CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ), LDB )
+     $   CALL SLASET( 'Full', N-M, NRHS, ZERO, ZERO, B( M+1, 1 ),
+     $                LDB )
 *
 *     B := Q' * B
 *
-      CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B, LDB,
-     $             WORK, LWORK, INFO )
+      CALL SORMLQ( 'Left', 'Transpose', N, NRHS, M, A, LDA, TAU, B,
+     $             LDB, WORK, LWORK, INFO )
 *
       RETURN
 *
diff --git a/lapack-netlib/SRC/DEPRECATED/sgeqrs.f b/lapack-netlib/SRC/DEPRECATED/sgeqrs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       REAL               A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE SGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       REAL               A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
diff --git a/lapack-netlib/SRC/DEPRECATED/zgelqs.f b/lapack-netlib/SRC/DEPRECATED/zgelqs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       COMPLEX*16         A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE ZGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       COMPLEX*16         A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================
diff --git a/lapack-netlib/SRC/DEPRECATED/zgeqrs.f b/lapack-netlib/SRC/DEPRECATED/zgeqrs.f
@@ -16,7 +16,7 @@
 *       ..
 *       .. Array Arguments ..
 *       COMPLEX*16         A( LDA, * ), B( LDB, * ), TAU( * ),
-*      $                   WORK( LWORK )
+*      $                   WORK( * )
 *       ..
 *
 *
@@ -128,7 +128,7 @@ SUBROUTINE ZGEQRS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,
 *     ..
 *     .. Array Arguments ..
       COMPLEX*16         A( LDA, * ), B( LDB, * ), TAU( * ),
-     $                   WORK( LWORK )
+     $                   WORK( * )
 *     ..
 *
 *  =====================================================================

Original file line number	Diff line number	Diff line change
`@@ -16,7 +16,7 @@`
`16`	`16`	`* ..`
`17`	`17`	`* .. Array Arguments ..`
`18`	`18`	`* COMPLEX A( LDA, * ), B( LDB, * ), TAU( * ),`
`19`		`-* $ WORK( LWORK )`
	`19`	`+* $ WORK( * )`
`20`	`20`	`* ..`
`21`	`21`	`*`
`22`	`22`	`*`
`@@ -128,7 +128,7 @@ SUBROUTINE CGELQS( M, N, NRHS, A, LDA, TAU, B, LDB, WORK, LWORK,`
`128`	`128`	`* ..`
`129`	`129`	`* .. Array Arguments ..`
`130`	`130`	`COMPLEX A( LDA, * ), B( LDB, * ), TAU( * ),`
`131`		`- $ WORK( LWORK )`
	`131`	`+ $ WORK( * )`
`132`	`132`	`* ..`
`133`	`133`	`*`
`134`	`134`	`* =====================================================================`