Skip to content

Fix truncating large workspace values #1195

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
langou merged 2 commits into from
Mar 25, 2026
Merged

Fix truncating large workspace values #1195

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
15f395c
Fix truncating large workspace values
jberg5 Feb 27, 2026
93f72dd
Merge branch 'master' into fix-f32-issue
langou Mar 24, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion SRC/zgesvj.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -474,7 +474,7 @@ SUBROUTINE ZGESVJ( JOBA, JOBU, JOBV, M, N, A, LDA, SVA, MV, V,
RETURN
ELSE IF( LQUERY ) THEN
CWORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
RETURN
END IF
*
Expand Down
4 changes: 2 additions & 2 deletions SRC/zhbevd.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -290,7 +290,7 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -387,7 +387,7 @@ SUBROUTINE ZHBEVD( JOBZ, UPLO, N, KD, AB, LDAB, W, Z, LDZ,
END IF
*
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
RETURN
*
Expand Down
4 changes: 2 additions & 2 deletions SRC/zhbevd_2stage.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -344,7 +344,7 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z,
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -446,7 +446,7 @@ SUBROUTINE ZHBEVD_2STAGE( JOBZ, UPLO, N, KD, AB, LDAB, W, Z,
END IF
*
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
RETURN
*
Expand Down
4 changes: 2 additions & 2 deletions SRC/zhbgvd.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -324,7 +324,7 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB,
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -391,7 +391,7 @@ SUBROUTINE ZHBGVD( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB,
END IF
*
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
RETURN
*
Expand Down
4 changes: 2 additions & 2 deletions SRC/zheevd.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -284,7 +284,7 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
LIOPT = LIWMIN
END IF
WORK( 1 ) = LOPT
RWORK( 1 ) = REAL( LROPT )
RWORK( 1 ) = DBLE( LROPT )
IWORK( 1 ) = LIOPT
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -380,7 +380,7 @@ SUBROUTINE ZHEEVD( JOBZ, UPLO, N, A, LDA, W, WORK, LWORK,
END IF
*
WORK( 1 ) = LOPT
RWORK( 1 ) = REAL( LROPT )
RWORK( 1 ) = DBLE( LROPT )
IWORK( 1 ) = LIOPT
*
RETURN
Expand Down
4 changes: 2 additions & 2 deletions SRC/zheevd_2stage.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -337,7 +337,7 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK,
END IF
END IF
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -436,7 +436,7 @@ SUBROUTINE ZHEEVD_2STAGE( JOBZ, UPLO, N, A, LDA, W, WORK,
END IF
*
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
RETURN
Expand Down
4 changes: 2 additions & 2 deletions SRC/zheevr.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -479,7 +479,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL,
NB = MAX( NB, ILAENV( 1, 'ZUNMTR', UPLO, N, -1, -1, -1 ) )
LWKOPT = MAX( ( NB+1 )*N, LWMIN )
WORK( 1 ) = LWKOPT
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -736,7 +736,7 @@ SUBROUTINE ZHEEVR( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL,
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = LWKOPT
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
RETURN
Expand Down
4 changes: 2 additions & 2 deletions SRC/zheevr_2stage.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -521,7 +521,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
*
IF( INFO.EQ.0 ) THEN
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -781,7 +781,7 @@ SUBROUTINE ZHEEVR_2STAGE( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU,
* Set WORK(1) to optimal workspace size.
*
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
RETURN
Expand Down
4 changes: 2 additions & 2 deletions SRC/zhpevd.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -270,7 +270,7 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
END IF
END IF
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -363,7 +363,7 @@ SUBROUTINE ZHPEVD( JOBZ, UPLO, N, AP, W, Z, LDZ, WORK, LWORK,
END IF
*
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
RETURN
*
Expand Down
4 changes: 2 additions & 2 deletions SRC/zstedc.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -296,7 +296,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
LIWMIN = 3 + 5*N
END IF
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
IF( LWORK.LT.LWMIN .AND. .NOT.LQUERY ) THEN
Expand Down Expand Up @@ -472,7 +472,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
*
70 CONTINUE
WORK( 1 ) = LWMIN
RWORK( 1 ) = REAL( LRWMIN )
RWORK( 1 ) = DBLE( LRWMIN )
IWORK( 1 ) = LIWMIN
*
RETURN
Expand Down
3 changes: 3 additions & 0 deletions TESTING/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -177,6 +177,9 @@ add_lapack_test(zlse.out lse.in xeigtstz)
#
# ======== COMPLEX16 DMD EIG TESTS ===========================
add_lapack_test(zdmd.out zdmd.in xdmdeigtstz)
#
# ======== COMPLEX16 WORKSPACE QUERY PRECISION TEST ===========
add_test(NAME LAPACK-test_wq_zrwork COMMAND $<TARGET_FILE:test_wq_zrwork>)
endif()


Expand Down
1 change: 1 addition & 0 deletions TESTING/EIG/CMakeLists.txt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -128,4 +128,5 @@ endif()
if(BUILD_COMPLEX16)
add_eig_executable(xeigtstz ${ZEIGTST} ${DZIGTST} ${AEIGTST})
add_eig_executable(xdmdeigtstz ${ZDMDEIGTST})
add_eig_executable(test_wq_zrwork test_wq_rwork.f)
endif()
182 changes: 182 additions & 0 deletions TESTING/EIG/test_wq_rwork.f
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,182 @@
*> \brief Test workspace query precision for z* RWORK
*
* =========== DOCUMENTATION ===========
*
* Purpose
* =======
*
* TEST_WQ_RWORK validates that workspace query calls (LWORK=-1,
* LRWORK=-1, LIWORK=-1) return exact RWORK sizes for COMPLEX*16
* routines with O(N^2) LRWMIN formulas.
*
* When LRWMIN > 2^24 (approx N > 2896 for formula 1+5N+2N^2),
* storing the value through a REAL (float32) intermediary loses
* precision. This test catches that regression by checking
* INT(RWORK(1)) == expected at N values above the threshold.
*
* No large matrices are allocated -- workspace queries return
* immediately after storing sizes, so the test runs in microseconds.
*
* =========== END DOCUMENTATION ========
*
PROGRAM TEST_WQ_RWORK
*
IMPLICIT NONE
*
* .. Parameters ..
INTEGER NNVALS
PARAMETER ( NNVALS = 3 )
*
* .. Local Scalars ..
INTEGER INFO, N, LRWEXP, NFAIL, NPASS, I, LRWGOT
*
* .. Local Arrays ..
* Minimal dummy arrays for workspace queries (never accessed
* by the routines when LWORK=-1).
INTEGER NVALS( NNVALS ), IWORK( 1 )
COMPLEX*16 A( 1 ), B( 1 ), AB( 1 ), BB( 1 )
COMPLEX*16 AP( 1 ), BP( 1 ), Z( 1 ), WORK( 1 )
DOUBLE PRECISION W( 1 ), RWORK( 1 ), D( 1 ), E( 1 )
*
* .. External Subroutines ..
EXTERNAL ZHEEVD, ZHEGVD, ZHBEVD, ZHPEVD
EXTERNAL ZHPGVD, ZHBGVD, ZSTEDC
*
* Test N values: 1000 (below 2^24 threshold), 3000 and 5000 (above)
DATA NVALS / 1000, 3000, 5000 /
Copy link
Copy Markdown
Collaborator

@mgates3 mgates3 Mar 25, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, for n = 3000 or n = 5000, the LRWMIN = 1 + 5n + 2n^2 = 18 015 001 or 50 025 001, which are > 2^24 = 16 777 216. In both cases, rounding to float32 will truncate the lrwork:

>>> int( numpy.float32( 18015001 ) )
18015000
>>> int( numpy.float32( 50025001. ) )
50025000

*
* .. Executable Statements ..
*
NFAIL = 0
NPASS = 0
*
WRITE( *, * ) 'Workspace query precision test for z* RWORK'
WRITE( *, * ) '============================================'
WRITE( *, * )
*
DO 100 I = 1, NNVALS
N = NVALS( I )
*
* Expected LRWMIN for JOBZ='V': 1 + 5*N + 2*N**2
* (common to ZHEEVD, ZHEGVD, ZHBEVD, ZHPEVD, ZHPGVD, ZHBGVD)
*
LRWEXP = 1 + 5*N + 2*N*N
*
* ---- ZHEEVD ----
*
INFO = 0
CALL ZHEEVD( 'V', 'U', N, A, N, W,
$ WORK, -1, RWORK, -1, IWORK, -1, INFO )
LRWGOT = INT( RWORK( 1 ) )
IF( INFO.EQ.0 .AND. LRWGOT.EQ.LRWEXP ) THEN
NPASS = NPASS + 1
ELSE
NFAIL = NFAIL + 1
WRITE( *, 9999 ) 'ZHEEVD ', N, LRWEXP, LRWGOT, INFO
END IF
*
* ---- ZHEGVD ----
*
INFO = 0
CALL ZHEGVD( 1, 'V', 'U', N, A, N, B, N, W,
$ WORK, -1, RWORK, -1, IWORK, -1, INFO )
LRWGOT = INT( RWORK( 1 ) )
IF( INFO.EQ.0 .AND. LRWGOT.EQ.LRWEXP ) THEN
NPASS = NPASS + 1
ELSE
NFAIL = NFAIL + 1
WRITE( *, 9999 ) 'ZHEGVD ', N, LRWEXP, LRWGOT, INFO
END IF
*
* ---- ZHBEVD ----
* KD=0 (diagonal band matrix), LDAB=1, LDZ=N
*
INFO = 0
CALL ZHBEVD( 'V', 'U', N, 0, AB, 1, W, Z, N,
$ WORK, -1, RWORK, -1, IWORK, -1, INFO )
LRWGOT = INT( RWORK( 1 ) )
IF( INFO.EQ.0 .AND. LRWGOT.EQ.LRWEXP ) THEN
NPASS = NPASS + 1
ELSE
NFAIL = NFAIL + 1
WRITE( *, 9999 ) 'ZHBEVD ', N, LRWEXP, LRWGOT, INFO
END IF
*
* ---- ZHPEVD ----
* LDZ=N
*
INFO = 0
CALL ZHPEVD( 'V', 'U', N, AP, W, Z, N,
$ WORK, -1, RWORK, -1, IWORK, -1, INFO )
LRWGOT = INT( RWORK( 1 ) )
IF( INFO.EQ.0 .AND. LRWGOT.EQ.LRWEXP ) THEN
NPASS = NPASS + 1
ELSE
NFAIL = NFAIL + 1
WRITE( *, 9999 ) 'ZHPEVD ', N, LRWEXP, LRWGOT, INFO
END IF
*
* ---- ZHPGVD ----
* ITYPE=1, LDZ=N
*
INFO = 0
CALL ZHPGVD( 1, 'V', 'U', N, AP, BP, W, Z, N,
$ WORK, -1, RWORK, -1, IWORK, -1, INFO )
LRWGOT = INT( RWORK( 1 ) )
IF( INFO.EQ.0 .AND. LRWGOT.EQ.LRWEXP ) THEN
NPASS = NPASS + 1
ELSE
NFAIL = NFAIL + 1
WRITE( *, 9999 ) 'ZHPGVD ', N, LRWEXP, LRWGOT, INFO
END IF
*
* ---- ZHBGVD ----
* KA=0, KB=0, LDAB=1, LDBB=1, LDZ=N
*
INFO = 0
CALL ZHBGVD( 'V', 'U', N, 0, 0, AB, 1, BB, 1,
$ W, Z, N,
$ WORK, -1, RWORK, -1, IWORK, -1, INFO )
LRWGOT = INT( RWORK( 1 ) )
IF( INFO.EQ.0 .AND. LRWGOT.EQ.LRWEXP ) THEN
NPASS = NPASS + 1
ELSE
NFAIL = NFAIL + 1
WRITE( *, 9999 ) 'ZHBGVD ', N, LRWEXP, LRWGOT, INFO
END IF
*
* ---- ZSTEDC (COMPZ='I') ----
* Expected: 1 + 4*N + 2*N**2
*
LRWEXP = 1 + 4*N + 2*N*N
*
INFO = 0
CALL ZSTEDC( 'I', N, D, E, Z, N,
$ WORK, -1, RWORK, -1, IWORK, -1, INFO )
LRWGOT = INT( RWORK( 1 ) )
IF( INFO.EQ.0 .AND. LRWGOT.EQ.LRWEXP ) THEN
NPASS = NPASS + 1
ELSE
NFAIL = NFAIL + 1
WRITE( *, 9999 ) 'ZSTEDC ', N, LRWEXP, LRWGOT, INFO
END IF
*
100 CONTINUE
*
* Print summary
*
WRITE( *, * )
IF( NFAIL.EQ.0 ) THEN
WRITE( *, 9998 ) NPASS
ELSE
WRITE( *, 9997 ) NFAIL, NFAIL + NPASS
END IF
*
9999 FORMAT( ' FAIL: ', A7, ' N=', I6,
$ ' expected=', I12, ' got=', I12, ' INFO=', I4 )
9998 FORMAT( ' All ', I3, ' workspace query tests PASSED' )
9997 FORMAT( ' ', I3, ' of ', I3, ' tests FAILED' )
*
IF( NFAIL.NE.0 ) STOP 1
*
END
Loading