From 280e16145dff7de25a2e64acb6e262252eb0525d Mon Sep 17 00:00:00 2001
From: Dmitry Klyuchinsky <dmitriy_klyuchinskiy@mail.ru>
Date: Mon, 4 Dec 2023 16:33:50 +0700
Subject: [PATCH] add missed usage of sroundup_lwork in several functions

---
 SRC/cgehrd.f    |  2 +-
 SRC/cgeqr.f     |  2 +-
 SRC/cgesvdx.f   | 10 +++++-----
 SRC/cgghd3.f    |  3 ++-
 SRC/cheevd.f    |  8 ++++----
 SRC/chetrf.f    |  2 +-
 SRC/chetrf_rk.f |  2 +-
 SRC/chetri2.f   |  5 +++--
 SRC/chetrs_aa.f |  2 +-
 SRC/dgehrd.f    |  2 +-
 SRC/dgghd3.f    |  1 +
 SRC/dsytrf.f    |  1 +
 SRC/dsytri2.f   |  7 ++++---
 SRC/sgehrd.f    |  2 +-
 SRC/sgeqp3rk.f  |  2 +-
 SRC/ssytrf.f    |  5 +++--
 SRC/ssytri2.f   |  1 +
 SRC/zgehrd.f    |  2 +-
 SRC/zgeqr.f     |  2 +-
 SRC/zgghd3.f    |  1 +
 SRC/zhetrf.f    |  3 ++-
 SRC/zhetrf_rk.f |  2 +-
 SRC/zhetri2.f   |  1 +
 SRC/zhetrs_aa.f |  2 +-
 SRC/zlatsqr.f   |  4 ++--
 25 files changed, 42 insertions(+), 32 deletions(-)

diff --git a/SRC/cgehrd.f b/SRC/cgehrd.f
index 7c62694f39..7ba87cc01b 100644
--- a/SRC/cgehrd.f
+++ b/SRC/cgehrd.f
@@ -274,7 +274,7 @@ SUBROUTINE CGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
 *           Determine if workspace is large enough for blocked code
 *
-            IF( LWORK.LT.N*NB+TSIZE ) THEN
+            IF( LWORK.LT.LWKOPT ) THEN
 *
 *              Not enough workspace to use optimal NB:  determine the
 *              minimum value of NB, and reduce NB or force use of
diff --git a/SRC/cgeqr.f b/SRC/cgeqr.f
index 494ca5fe40..3617594d02 100644
--- a/SRC/cgeqr.f
+++ b/SRC/cgeqr.f
@@ -273,7 +273,7 @@ SUBROUTINE CGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
       ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
      $   .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
         INFO = -6
-      ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY )
+      ELSE IF( ( LWORK.LT.LWREQ ) .AND. ( .NOT.LQUERY )
      $   .AND. ( .NOT.LMINWS ) ) THEN
         INFO = -8
       END IF
diff --git a/SRC/cgesvdx.f b/SRC/cgesvdx.f
index 51e69cbe0f..e1856a65fd 100644
--- a/SRC/cgesvdx.f
+++ b/SRC/cgesvdx.f
@@ -208,7 +208,7 @@
 *> \param[out] WORK
 *> \verbatim
 *>          WORK is COMPLEX array, dimension (MAX(1,LWORK))
-*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK;
+*>          On exit, if INFO = 0, WORK(1) returns the optimal LWORK.
 *> \endverbatim
 *>
 *> \param[in] LWORK
@@ -312,8 +312,8 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
 *     .. External Functions ..
       LOGICAL            LSAME
       INTEGER            ILAENV
-      REAL               SLAMCH, CLANGE
-      EXTERNAL           LSAME, ILAENV, SLAMCH, CLANGE
+      REAL               SLAMCH, CLANGE, SROUNDUP_LWORK
+      EXTERNAL           LSAME, ILAENV, SLAMCH, CLANGE, SROUNDUP_LWORK
 *     ..
 *     .. Intrinsic Functions ..
       INTRINSIC          MAX, MIN, SQRT
@@ -448,7 +448,7 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
             END IF
          END IF
          MAXWRK = MAX( MAXWRK, MINWRK )
-         WORK( 1 ) = CMPLX( REAL( MAXWRK ), ZERO )
+         WORK( 1 ) = SROUNDUP_LWORK( MAXWRK )
 *
          IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
             INFO = -19
@@ -846,7 +846,7 @@ SUBROUTINE CGESVDX( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
 *
 *     Return optimal workspace in WORK(1)
 *
-      WORK( 1 ) = CMPLX( REAL( MAXWRK ), ZERO )
+      WORK( 1 ) = SROUNDUP_LWORK( MAXWRK )
 *
       RETURN
 *
diff --git a/SRC/cgghd3.f b/SRC/cgghd3.f
index c4123e4c76..f7175a72c7 100644
--- a/SRC/cgghd3.f
+++ b/SRC/cgghd3.f
@@ -893,7 +893,8 @@ SUBROUTINE CGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
       IF ( JCOL.LT.IHI )
      $   CALL CGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
      $                LDQ, Z, LDZ, IERR )
-      WORK( 1 ) = CMPLX( LWKOPT )
+*
+      WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
 *
       RETURN
 *
diff --git a/SRC/cheevd.f b/SRC/cheevd.f
index e24850f5a7..9b62a2df60 100644
--- a/SRC/cheevd.f
+++ b/SRC/cheevd.f
@@ -281,8 +281,8 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
             LROPT = LRWMIN
             LIOPT = LIWMIN
          END IF
-         WORK( 1 ) = SROUNDUP_LWORK(LOPT)
-         RWORK( 1 ) = LROPT
+         WORK( 1 ) = SROUNDUP_LWORK( LOPT )
+         RWORK( 1 ) = SROUNDUP_LWORK( LROPT )
          IWORK( 1 ) = LIOPT
 *
          IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
@@ -377,8 +377,8 @@ SUBROUTINE CHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK, RWORK,
          CALL SSCAL( IMAX, ONE / SIGMA, W, 1 )
       END IF
 *
-      WORK( 1 ) = SROUNDUP_LWORK(LOPT)
-      RWORK( 1 ) = LROPT
+      WORK( 1 ) = SROUNDUP_LWORK( LOPT )
+      RWORK( 1 ) = SROUNDUP_LWORK( LROPT )
       IWORK( 1 ) = LIOPT
 *
       RETURN
diff --git a/SRC/chetrf.f b/SRC/chetrf.f
index 2b44956283..2836e30bcc 100644
--- a/SRC/chetrf.f
+++ b/SRC/chetrf.f
@@ -228,7 +228,7 @@ SUBROUTINE CHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
 *        Determine the block size
 *
          NB = ILAENV( 1, 'CHETRF', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
+         LWKOPT = MAX( 1, N*NB )
          WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
       END IF
 *
diff --git a/SRC/chetrf_rk.f b/SRC/chetrf_rk.f
index bbf0578dfc..a13c740e3c 100644
--- a/SRC/chetrf_rk.f
+++ b/SRC/chetrf_rk.f
@@ -311,7 +311,7 @@ SUBROUTINE CHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
 *        Determine the block size
 *
          NB = ILAENV( 1, 'CHETRF_RK', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
+         LWKOPT = MAX( 1, N*NB )
          WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
       END IF
 *
diff --git a/SRC/chetri2.f b/SRC/chetri2.f
index 33e4dc5259..f15065ae7d 100644
--- a/SRC/chetri2.f
+++ b/SRC/chetri2.f
@@ -178,7 +178,7 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
 *
@@ -195,11 +195,12 @@ SUBROUTINE CHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       IF( N.EQ.0 )
      $   RETURN
 
-      IF( NBMAX .GE. N ) THEN
+      IF( NBMAX.GE.N ) THEN
          CALL CHETRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
       ELSE
          CALL CHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
       END IF
+*
       RETURN
 *
 *     End of CHETRI2
diff --git a/SRC/chetrs_aa.f b/SRC/chetrs_aa.f
index 51a817dedc..07179ab923 100644
--- a/SRC/chetrs_aa.f
+++ b/SRC/chetrs_aa.f
@@ -204,7 +204,7 @@ SUBROUTINE CHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
 *
 *     Quick return if possible
 *
-      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+      IF( MIN( N, NRHS ).EQ.0 )
      $   RETURN
 *
       IF( UPPER ) THEN
diff --git a/SRC/dgehrd.f b/SRC/dgehrd.f
index 90a8b69498..d95bbd1827 100644
--- a/SRC/dgehrd.f
+++ b/SRC/dgehrd.f
@@ -273,7 +273,7 @@ SUBROUTINE DGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
 *           Determine if workspace is large enough for blocked code
 *
-            IF( LWORK.LT.N*NB+TSIZE ) THEN
+            IF( LWORK.LT.LWKOPT ) THEN
 *
 *              Not enough workspace to use optimal NB:  determine the
 *              minimum value of NB, and reduce NB or force use of
diff --git a/SRC/dgghd3.f b/SRC/dgghd3.f
index f3bdf75ae8..21a6685734 100644
--- a/SRC/dgghd3.f
+++ b/SRC/dgghd3.f
@@ -889,6 +889,7 @@ SUBROUTINE DGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
       IF ( JCOL.LT.IHI )
      $   CALL DGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
      $                LDQ, Z, LDZ, IERR )
+*
       WORK( 1 ) = DBLE( LWKOPT )
 *
       RETURN
diff --git a/SRC/dsytrf.f b/SRC/dsytrf.f
index 7a7d99b1b1..2a1a2d4dc4 100644
--- a/SRC/dsytrf.f
+++ b/SRC/dsytrf.f
@@ -352,6 +352,7 @@ SUBROUTINE DSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       END IF
 *
    40 CONTINUE
+*
       WORK( 1 ) = LWKOPT
       RETURN
 *
diff --git a/SRC/dsytri2.f b/SRC/dsytri2.f
index e7333f9fbf..5960d39928 100644
--- a/SRC/dsytri2.f
+++ b/SRC/dsytri2.f
@@ -165,7 +165,7 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       NBMAX = ILAENV( 1, 'DSYTRI2', UPLO, N, -1, -1, -1 )
       IF( N.EQ.0 ) THEN
          MINSIZE = 1
-      ELSE IF ( NBMAX.GE.N ) THEN
+      ELSE IF( NBMAX.GE.N ) THEN
          MINSIZE = N
       ELSE
          MINSIZE = (N+NBMAX+1)*(NBMAX+3)
@@ -177,7 +177,7 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
          INFO = -2
       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
          INFO = -4
-      ELSE IF ( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
+      ELSE IF( LWORK.LT.MINSIZE .AND. .NOT.LQUERY ) THEN
          INFO = -7
       END IF
 *
@@ -194,11 +194,12 @@ SUBROUTINE DSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       IF( N.EQ.0 )
      $   RETURN
 
-      IF( NBMAX .GE. N ) THEN
+      IF( NBMAX.GE.N ) THEN
          CALL DSYTRI( UPLO, N, A, LDA, IPIV, WORK, INFO )
       ELSE
          CALL DSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
       END IF
+*
       RETURN
 *
 *     End of DSYTRI2
diff --git a/SRC/sgehrd.f b/SRC/sgehrd.f
index 33f6c71718..cfa17e156f 100644
--- a/SRC/sgehrd.f
+++ b/SRC/sgehrd.f
@@ -274,7 +274,7 @@ SUBROUTINE SGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
 *           Determine if workspace is large enough for blocked code
 *
-            IF( LWORK.LT.N*NB+TSIZE ) THEN
+            IF( LWORK.LT.LWKOPT ) THEN
 *
 *              Not enough workspace to use optimal NB:  determine the
 *              minimum value of NB, and reduce NB or force use of
diff --git a/SRC/sgeqp3rk.f b/SRC/sgeqp3rk.f
index f852fb360b..d3a335b88e 100755
--- a/SRC/sgeqp3rk.f
+++ b/SRC/sgeqp3rk.f
@@ -824,7 +824,7 @@ SUBROUTINE SGEQP3RK( M, N, NRHS, KMAX, ABSTOL, RELTOL, A, LDA,
          DO J = 1, MINMN
             TAU( J ) = ZERO
          END DO
-         WORK( 1 ) = REAL( LWKOPT )
+         WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
          RETURN
       END IF
 *
diff --git a/SRC/ssytrf.f b/SRC/ssytrf.f
index a788fbcf07..55f3a4f0fe 100644
--- a/SRC/ssytrf.f
+++ b/SRC/ssytrf.f
@@ -234,7 +234,7 @@ SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
 *
          NB = ILAENV( 1, 'SSYTRF', UPLO, N, -1, -1, -1 )
          LWKOPT = MAX( 1, N*NB )
-         WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
+         WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
       END IF
 *
       IF( INFO.NE.0 ) THEN
@@ -353,7 +353,8 @@ SUBROUTINE SSYTRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       END IF
 *
    40 CONTINUE
-      WORK( 1 ) = SROUNDUP_LWORK(LWKOPT)
+*
+      WORK( 1 ) = SROUNDUP_LWORK( LWKOPT )
       RETURN
 *
 *     End of SSYTRF
diff --git a/SRC/ssytri2.f b/SRC/ssytri2.f
index ba83605cc9..fd1c53473d 100644
--- a/SRC/ssytri2.f
+++ b/SRC/ssytri2.f
@@ -200,6 +200,7 @@ SUBROUTINE SSYTRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       ELSE
          CALL SSYTRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
       END IF
+*
       RETURN
 *
 *     End of SSYTRI2
diff --git a/SRC/zgehrd.f b/SRC/zgehrd.f
index 36b576cbc9..0f4424ded6 100644
--- a/SRC/zgehrd.f
+++ b/SRC/zgehrd.f
@@ -273,7 +273,7 @@ SUBROUTINE ZGEHRD( N, ILO, IHI, A, LDA, TAU, WORK, LWORK, INFO )
 *
 *           Determine if workspace is large enough for blocked code
 *
-            IF( LWORK.LT.N*NB+TSIZE ) THEN
+            IF( LWORK.LT.LWKOPT ) THEN
 *
 *              Not enough workspace to use optimal NB:  determine the
 *              minimum value of NB, and reduce NB or force use of
diff --git a/SRC/zgeqr.f b/SRC/zgeqr.f
index 7f37a4c7ff..7df9c2403d 100644
--- a/SRC/zgeqr.f
+++ b/SRC/zgeqr.f
@@ -272,7 +272,7 @@ SUBROUTINE ZGEQR( M, N, A, LDA, T, TSIZE, WORK, LWORK,
       ELSE IF( TSIZE.LT.MAX( 1, NB*N*NBLCKS + 5 )
      $   .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
         INFO = -6
-      ELSE IF( ( LWORK.LT.MAX( 1, N*NB ) ) .AND. ( .NOT.LQUERY )
+      ELSE IF( ( LWORK.LT.LWREQ ) .AND. ( .NOT.LQUERY )
      $   .AND. ( .NOT.LMINWS ) ) THEN
         INFO = -8
       END IF
diff --git a/SRC/zgghd3.f b/SRC/zgghd3.f
index f466d42886..08343688de 100644
--- a/SRC/zgghd3.f
+++ b/SRC/zgghd3.f
@@ -887,6 +887,7 @@ SUBROUTINE ZGGHD3( COMPQ, COMPZ, N, ILO, IHI, A, LDA, B, LDB, Q,
       IF ( JCOL.LT.IHI )
      $   CALL ZGGHRD( COMPQ2, COMPZ2, N, JCOL, IHI, A, LDA, B, LDB, Q,
      $                LDQ, Z, LDZ, IERR )
+*
       WORK( 1 ) = DCMPLX( LWKOPT )
 *
       RETURN
diff --git a/SRC/zhetrf.f b/SRC/zhetrf.f
index a8df90ffe9..433887108b 100644
--- a/SRC/zhetrf.f
+++ b/SRC/zhetrf.f
@@ -227,7 +227,7 @@ SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
 *        Determine the block size
 *
          NB = ILAENV( 1, 'ZHETRF', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
+         LWKOPT = MAX( 1, N*NB )
          WORK( 1 ) = LWKOPT
       END IF
 *
@@ -346,6 +346,7 @@ SUBROUTINE ZHETRF( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       END IF
 *
    40 CONTINUE
+*
       WORK( 1 ) = LWKOPT
       RETURN
 *
diff --git a/SRC/zhetrf_rk.f b/SRC/zhetrf_rk.f
index 01b3e412dc..7c505fa4de 100644
--- a/SRC/zhetrf_rk.f
+++ b/SRC/zhetrf_rk.f
@@ -310,7 +310,7 @@ SUBROUTINE ZHETRF_RK( UPLO, N, A, LDA, E, IPIV, WORK, LWORK,
 *        Determine the block size
 *
          NB = ILAENV( 1, 'ZHETRF_RK', UPLO, N, -1, -1, -1 )
-         LWKOPT = N*NB
+         LWKOPT = MAX( 1, N*NB )
          WORK( 1 ) = LWKOPT
       END IF
 *
diff --git a/SRC/zhetri2.f b/SRC/zhetri2.f
index bfbb94827e..1d932b866c 100644
--- a/SRC/zhetri2.f
+++ b/SRC/zhetri2.f
@@ -199,6 +199,7 @@ SUBROUTINE ZHETRI2( UPLO, N, A, LDA, IPIV, WORK, LWORK, INFO )
       ELSE
          CALL ZHETRI2X( UPLO, N, A, LDA, IPIV, WORK, NBMAX, INFO )
       END IF
+*
       RETURN
 *
 *     End of ZHETRI2
diff --git a/SRC/zhetrs_aa.f b/SRC/zhetrs_aa.f
index a75fcd9cbb..b7a1f7f07b 100644
--- a/SRC/zhetrs_aa.f
+++ b/SRC/zhetrs_aa.f
@@ -204,7 +204,7 @@ SUBROUTINE ZHETRS_AA( UPLO, N, NRHS, A, LDA, IPIV, B, LDB,
 *
 *     Quick return if possible
 *
-      IF( N.EQ.0 .OR. NRHS.EQ.0 )
+      IF( MIN( N, NRHS ).EQ.0 )
      $   RETURN
 *
       IF( UPPER ) THEN
diff --git a/SRC/zlatsqr.f b/SRC/zlatsqr.f
index b2fe3aa111..24d00f28a8 100644
--- a/SRC/zlatsqr.f
+++ b/SRC/zlatsqr.f
@@ -112,7 +112,7 @@
 *>          LWORK >= 1, if MIN(M,N) = 0, and LWORK >= NB*N, otherwise.
 *>
 *>          If LWORK = -1, then a workspace query is assumed; the routine
-*>          only calculates the optimal size of the WORK array, returns
+*>          only calculates the minimal size of the WORK array, returns
 *>          this value as the first entry of the WORK array, and no error
 *>          message related to LWORK is issued by XERBLA.
 *> \endverbatim
@@ -252,7 +252,7 @@ SUBROUTINE ZLATSQR( M, N, MB, NB, A, LDA, T, LDT, WORK,
         RETURN
       END IF
       KK = MOD((M-N),(MB-N))
-      II=M-KK+1
+      II = M-KK+1
 *
 *     Compute the QR factorization of the first block A(1:MB,1:N)
 *