From 7e4d5c237cb10642a9cbf3c173b06045dd10c230 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Fri, 18 Sep 2020 09:19:46 +0200 Subject: [PATCH] Fix workspace query in xGELQ (Reference-LAPACK PR443) --- lapack-netlib/SRC/cgelq.f | 30 +++++++++++++++++++++--------- lapack-netlib/SRC/cgetsls.f | 2 +- lapack-netlib/SRC/dgelq.f | 30 +++++++++++++++++++++--------- lapack-netlib/SRC/dgetsls.f | 2 +- lapack-netlib/SRC/sgelq.f | 30 +++++++++++++++++++++--------- lapack-netlib/SRC/sgetsls.f | 2 +- lapack-netlib/SRC/zgelq.f | 30 +++++++++++++++++++++--------- lapack-netlib/SRC/zgetsls.f | 2 +- 8 files changed, 88 insertions(+), 40 deletions(-) diff --git a/lapack-netlib/SRC/cgelq.f b/lapack-netlib/SRC/cgelq.f index c3b2238bf..f0ff3a20d 100644 --- a/lapack-netlib/SRC/cgelq.f +++ b/lapack-netlib/SRC/cgelq.f @@ -26,7 +26,7 @@ *> where: *> *> Q is a N-by-N orthogonal matrix; -*> L is an lower-triangular M-by-M matrix; +*> L is a lower-triangular M-by-M matrix; *> 0 is a M-by-(N-M) zero matrix, if M < N. *> *> \endverbatim @@ -187,7 +187,7 @@ * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ * .. * .. External Functions .. LOGICAL LSAME @@ -243,20 +243,32 @@ * * Determine if the workspace size satisfies minimal size * + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWMIN = MAX( 1, N ) + LWOPT = MAX( 1, MB*N ) + ELSE + LWMIN = MAX( 1, M ) + LWOPT = MAX( 1, MB*M ) + END IF LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M ) - $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ ) + IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT ) + $ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN LMINWS = .TRUE. MB = 1 NB = N END IF - IF( LWORK.LT.MB*M ) THEN + IF( LWORK.LT.LWOPT ) THEN LMINWS = .TRUE. MB = 1 END IF END IF + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWREQ = MAX( 1, MB*N ) + ELSE + LWREQ = MAX( 1, MB*M ) + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -267,7 +279,7 @@ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF @@ -281,9 +293,9 @@ T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = LWMIN ELSE - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ END IF END IF IF( INFO.NE.0 ) THEN @@ -308,7 +320,7 @@ $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ * RETURN * diff --git a/lapack-netlib/SRC/cgetsls.f b/lapack-netlib/SRC/cgetsls.f index 3d783be66..01de3c984 100644 --- a/lapack-netlib/SRC/cgetsls.f +++ b/lapack-netlib/SRC/cgetsls.f @@ -261,7 +261,7 @@ TSZM = INT( TQ( 1 ) ) LWM = INT( WORKQ( 1 ) ) CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ, - $ TSZO, B, LDB, WORKQ, -1, INFO2 ) + $ TSZM, B, LDB, WORKQ, -1, INFO2 ) LWM = MAX( LWM, INT( WORKQ( 1 ) ) ) WSIZEO = TSZO + LWO WSIZEM = TSZM + LWM diff --git a/lapack-netlib/SRC/dgelq.f b/lapack-netlib/SRC/dgelq.f index fc14d892f..7b2f80862 100644 --- a/lapack-netlib/SRC/dgelq.f +++ b/lapack-netlib/SRC/dgelq.f @@ -26,7 +26,7 @@ *> where: *> *> Q is a N-by-N orthogonal matrix; -*> L is an lower-triangular M-by-M matrix; +*> L is a lower-triangular M-by-M matrix; *> 0 is a M-by-(N-M) zero matrix, if M < N. *> *> \endverbatim @@ -187,7 +187,7 @@ * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ * .. * .. External Functions .. LOGICAL LSAME @@ -243,20 +243,32 @@ * * Determine if the workspace size satisfies minimal size * + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWMIN = MAX( 1, N ) + LWOPT = MAX( 1, MB*N ) + ELSE + LWMIN = MAX( 1, M ) + LWOPT = MAX( 1, MB*M ) + END IF LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M ) - $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ ) + IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT ) + $ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN LMINWS = .TRUE. MB = 1 NB = N END IF - IF( LWORK.LT.MB*M ) THEN + IF( LWORK.LT.LWOPT ) THEN LMINWS = .TRUE. MB = 1 END IF END IF + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWREQ = MAX( 1, MB*N ) + ELSE + LWREQ = MAX( 1, MB*M ) + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -267,7 +279,7 @@ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF @@ -281,9 +293,9 @@ T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = LWMIN ELSE - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ END IF END IF IF( INFO.NE.0 ) THEN @@ -308,7 +320,7 @@ $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ * RETURN * diff --git a/lapack-netlib/SRC/dgetsls.f b/lapack-netlib/SRC/dgetsls.f index dfc72c8b2..c2ba5e2b8 100644 --- a/lapack-netlib/SRC/dgetsls.f +++ b/lapack-netlib/SRC/dgetsls.f @@ -258,7 +258,7 @@ TSZM = INT( TQ( 1 ) ) LWM = INT( WORKQ( 1 ) ) CALL DGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ, - $ TSZO, B, LDB, WORKQ, -1, INFO2 ) + $ TSZM, B, LDB, WORKQ, -1, INFO2 ) LWM = MAX( LWM, INT( WORKQ( 1 ) ) ) WSIZEO = TSZO + LWO WSIZEM = TSZM + LWM diff --git a/lapack-netlib/SRC/sgelq.f b/lapack-netlib/SRC/sgelq.f index 96c4097e8..e45c68db4 100644 --- a/lapack-netlib/SRC/sgelq.f +++ b/lapack-netlib/SRC/sgelq.f @@ -26,7 +26,7 @@ *> where: *> *> Q is a N-by-N orthogonal matrix; -*> L is an lower-triangular M-by-M matrix; +*> L is a lower-triangular M-by-M matrix; *> 0 is a M-by-(N-M) zero matrix, if M < N. *> *> \endverbatim @@ -187,7 +187,7 @@ * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ * .. * .. External Functions .. LOGICAL LSAME @@ -243,20 +243,32 @@ * * Determine if the workspace size satisfies minimal size * + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWMIN = MAX( 1, N ) + LWOPT = MAX( 1, MB*N ) + ELSE + LWMIN = MAX( 1, M ) + LWOPT = MAX( 1, MB*M ) + END IF LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M ) - $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ ) + IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT ) + $ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN LMINWS = .TRUE. MB = 1 NB = N END IF - IF( LWORK.LT.MB*M ) THEN + IF( LWORK.LT.LWOPT ) THEN LMINWS = .TRUE. MB = 1 END IF END IF + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWREQ = MAX( 1, MB*N ) + ELSE + LWREQ = MAX( 1, MB*M ) + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -267,7 +279,7 @@ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF @@ -281,9 +293,9 @@ T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = LWMIN ELSE - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ END IF END IF IF( INFO.NE.0 ) THEN @@ -308,7 +320,7 @@ $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ RETURN * * End of SGELQ diff --git a/lapack-netlib/SRC/sgetsls.f b/lapack-netlib/SRC/sgetsls.f index 53d2f9431..3bf084515 100644 --- a/lapack-netlib/SRC/sgetsls.f +++ b/lapack-netlib/SRC/sgetsls.f @@ -258,7 +258,7 @@ TSZM = INT( TQ( 1 ) ) LWM = INT( WORKQ( 1 ) ) CALL SGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ, - $ TSZO, B, LDB, WORKQ, -1, INFO2 ) + $ TSZM, B, LDB, WORKQ, -1, INFO2 ) LWM = MAX( LWM, INT( WORKQ( 1 ) ) ) WSIZEO = TSZO + LWO WSIZEM = TSZM + LWM diff --git a/lapack-netlib/SRC/zgelq.f b/lapack-netlib/SRC/zgelq.f index 4e7e7e38e..beb054b87 100644 --- a/lapack-netlib/SRC/zgelq.f +++ b/lapack-netlib/SRC/zgelq.f @@ -26,7 +26,7 @@ *> where: *> *> Q is a N-by-N orthogonal matrix; -*> L is an lower-triangular M-by-M matrix; +*> L is a lower-triangular M-by-M matrix; *> 0 is a M-by-(N-M) zero matrix, if M < N. *> *> \endverbatim @@ -187,7 +187,7 @@ * .. * .. Local Scalars .. LOGICAL LQUERY, LMINWS, MINT, MINW - INTEGER MB, NB, MINTSZ, NBLCKS + INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ * .. * .. External Functions .. LOGICAL LSAME @@ -243,20 +243,32 @@ * * Determine if the workspace size satisfies minimal size * + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWMIN = MAX( 1, N ) + LWOPT = MAX( 1, MB*N ) + ELSE + LWMIN = MAX( 1, M ) + LWOPT = MAX( 1, MB*M ) + END IF LMINWS = .FALSE. - IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M ) - $ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ ) + IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT ) + $ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ ) $ .AND. ( .NOT.LQUERY ) ) THEN IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN LMINWS = .TRUE. MB = 1 NB = N END IF - IF( LWORK.LT.MB*M ) THEN + IF( LWORK.LT.LWOPT ) THEN LMINWS = .TRUE. MB = 1 END IF END IF + IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN + LWREQ = MAX( 1, MB*N ) + ELSE + LWREQ = MAX( 1, MB*M ) + END IF * IF( M.LT.0 ) THEN INFO = -1 @@ -267,7 +279,7 @@ ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) $ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN INFO = -6 - ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY ) + ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY ) $ .AND. ( .NOT.LMINWS ) ) THEN INFO = -8 END IF @@ -281,9 +293,9 @@ T( 2 ) = MB T( 3 ) = NB IF( MINW ) THEN - WORK( 1 ) = MAX( 1, N ) + WORK( 1 ) = LWMIN ELSE - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ END IF END IF IF( INFO.NE.0 ) THEN @@ -308,7 +320,7 @@ $ LWORK, INFO ) END IF * - WORK( 1 ) = MAX( 1, MB*M ) + WORK( 1 ) = LWREQ * RETURN * diff --git a/lapack-netlib/SRC/zgetsls.f b/lapack-netlib/SRC/zgetsls.f index 1aab3c662..11233785b 100644 --- a/lapack-netlib/SRC/zgetsls.f +++ b/lapack-netlib/SRC/zgetsls.f @@ -261,7 +261,7 @@ TSZM = INT( TQ( 1 ) ) LWM = INT( WORKQ( 1 ) ) CALL ZGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ, - $ TSZO, B, LDB, WORKQ, -1, INFO2 ) + $ TSZM, B, LDB, WORKQ, -1, INFO2 ) LWM = MAX( LWM, INT( WORKQ( 1 ) ) ) WSIZEO = TSZO + LWO WSIZEM = TSZM + LWM