Skip to content

Commit 800bb92

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #6199 from martin-frbg/lapack1439
Fix documentation of and tests for ?GESVDMR3 workspace sizes (Reference-LAPACK PR 1439)
2 parents 40b20f4 + 64fdb9b commit 800bb92

8 files changed

Lines changed: 118 additions & 48 deletions

File tree

‎lapack-netlib/SRC/cgesvdmr3.f‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -213,11 +213,12 @@
213213
*> \verbatim
214214
*> LWORK is INTEGER
215215
*> The dimension of the array WORK.
216-
*> LWORK >= MAX(1,MIN(M,N)*(MIN(M,N)+4)) for the paths (see
216+
*> LWORK >= 1 if MIN(M,N) = 0; otherwise
217+
*> LWORK >= MIN(M,N)*(MIN(M,N)+5) for the paths (see
217218
*> comments inside the code):
218219
*> - PATH 1 (M much larger than N)
219220
*> - PATH 1t (N much larger than M)
220-
*> LWORK >= MAX(1,MIN(M,N)*2+MAX(M,N)) for the other paths.
221+
*> LWORK >= 3*MIN(M,N) + MAX(M,N) for the other paths.
221222
*> For good performance, LWORK should generally be larger.
222223
*>
223224
*> If LWORK = -1, then a workspace query is assumed; the routine

‎lapack-netlib/SRC/dgesvdmr3.f‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -212,11 +212,14 @@
212212
*> \verbatim
213213
*> LWORK is INTEGER
214214
*> The dimension of the array WORK.
215-
*> LWORK >= MAX(1,MIN(M,N)*(MIN(M,N)+4)) for the paths (see
215+
*> LWORK >= 1 if MIN(M,N) = 0; otherwise
216+
*> LWORK >= 8*MIN(M,N)**2 + 43*MIN(M,N) for the paths (see
216217
*> comments inside the code):
217218
*> - PATH 1 (M much larger than N)
218219
*> - PATH 1t (N much larger than M)
219-
*> LWORK >= MAX(1,MIN(M,N)*2+MAX(M,N)) for the other paths.
220+
*> LWORK >= MAX(7*MIN(M,N)**2 + 42*MIN(M,N),
221+
*> 5*MIN(M,N)**2 + 27*MIN(M,N) + MAX(M,N))
222+
*> for the other paths.
220223
*> For good performance, LWORK should generally be larger.
221224
*>
222225
*> If LWORK = -1, then a workspace query is assumed; the routine

‎lapack-netlib/SRC/sgesvdmr3.f‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -212,11 +212,14 @@
212212
*> \verbatim
213213
*> LWORK is INTEGER
214214
*> The dimension of the array WORK.
215-
*> LWORK >= MAX(1,MIN(M,N)*(MIN(M,N)+4)) for the paths (see
215+
*> LWORK >= 1 if MIN(M,N) = 0; otherwise
216+
*> LWORK >= 8*MIN(M,N)**2 + 43*MIN(M,N) for the paths (see
216217
*> comments inside the code):
217218
*> - PATH 1 (M much larger than N)
218219
*> - PATH 1t (N much larger than M)
219-
*> LWORK >= MAX(1,MIN(M,N)*2+MAX(M,N)) for the other paths.
220+
*> LWORK >= MAX(7*MIN(M,N)**2 + 42*MIN(M,N),
221+
*> 5*MIN(M,N)**2 + 27*MIN(M,N) + MAX(M,N))
222+
*> for the other paths.
220223
*> For good performance, LWORK should generally be larger.
221224
*>
222225
*> If LWORK = -1, then a workspace query is assumed; the routine

‎lapack-netlib/SRC/zgesvdmr3.f‎

Lines changed: 15 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -213,11 +213,12 @@
213213
*> \verbatim
214214
*> LWORK is INTEGER
215215
*> The dimension of the array WORK.
216-
*> LWORK >= MAX(1,MIN(M,N)*(MIN(M,N)+4)) for the paths (see
216+
*> LWORK >= 1 if MIN(M,N) = 0; otherwise
217+
*> LWORK >= MIN(M,N)*(MIN(M,N)+5) for the paths (see
217218
*> comments inside the code):
218219
*> - PATH 1 (M much larger than N)
219220
*> - PATH 1t (N much larger than M)
220-
*> LWORK >= MAX(1,MIN(M,N)*2+MAX(M,N)) for the other paths.
221+
*> LWORK >= 3*MIN(M,N) + MAX(M,N) for the other paths.
221222
*> For good performance, LWORK should generally be larger.
222223
*>
223224
*> If LWORK = -1, then a workspace query is assumed; the routine
@@ -290,6 +291,8 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
290291
* =====================================================================
291292
*
292293
* .. Parameters ..
294+
INTEGER DP
295+
PARAMETER ( DP = KIND( 0.0D0 ) )
293296
COMPLEX*16 CZERO, CONE
294297
PARAMETER ( CZERO = ( 0.0D0, 0.0D0 ),
295298
$ CONE = ( 1.0D0, 0.0D0 ) )
@@ -460,7 +463,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
460463
END IF
461464
END IF
462465
MAXWRK = MAX( MAXWRK, MINWRK )
463-
WORK( 1 ) = DCMPLX( DBLE( MAXWRK ), ZERO )
466+
WORK( 1 ) = CMPLX( DBLE( MAXWRK ), ZERO, KIND=DP )
464467
*
465468
IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
466469
INFO = -19
@@ -568,7 +571,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
568571
K = ITGKZ
569572
DO I = 1, NS
570573
DO J = 1, N
571-
U( J, I ) = DCMPLX( RWORK( K ), ZERO )
574+
U( J, I ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
572575
K = K + 1
573576
END DO
574577
K = K + N
@@ -597,7 +600,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
597600
K = ITGKZ + N
598601
DO I = 1, NS
599602
DO J = 1, N
600-
VT( I, J ) = DCMPLX( RWORK( K ), ZERO )
603+
VT( I, J ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
601604
K = K + 1
602605
END DO
603606
K = K + N
@@ -646,7 +649,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
646649
K = ITGKZ
647650
DO I = 1, NS
648651
DO J = 1, N
649-
U( J, I ) = DCMPLX( RWORK( K ), ZERO )
652+
U( J, I ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
650653
K = K + 1
651654
END DO
652655
K = K + N
@@ -668,7 +671,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
668671
K = ITGKZ + N
669672
DO I = 1, NS
670673
DO J = 1, N
671-
VT( I, J ) = DCMPLX( RWORK( K ), ZERO )
674+
VT( I, J ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
672675
K = K + 1
673676
END DO
674677
K = K + N
@@ -735,7 +738,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
735738
K = ITGKZ
736739
DO I = 1, NS
737740
DO J = 1, M
738-
U( J, I ) = DCMPLX( RWORK( K ), ZERO )
741+
U( J, I ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
739742
K = K + 1
740743
END DO
741744
K = K + M
@@ -755,7 +758,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
755758
K = ITGKZ + M
756759
DO I = 1, NS
757760
DO J = 1, M
758-
VT( I, J ) = DCMPLX( RWORK( K ), ZERO )
761+
VT( I, J ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
759762
K = K + 1
760763
END DO
761764
K = K + M
@@ -813,7 +816,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
813816
K = ITGKZ
814817
DO I = 1, NS
815818
DO J = 1, M
816-
U( J, I ) = DCMPLX( RWORK( K ), ZERO )
819+
U( J, I ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
817820
K = K + 1
818821
END DO
819822
K = K + M
@@ -833,7 +836,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
833836
K = ITGKZ + M
834837
DO I = 1, NS
835838
DO J = 1, M
836-
VT( I, J ) = DCMPLX( RWORK( K ), ZERO )
839+
VT( I, J ) = CMPLX( RWORK( K ), ZERO, KIND=DP )
837840
K = K + 1
838841
END DO
839842
K = K + M
@@ -865,7 +868,7 @@ SUBROUTINE ZGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA, VL, VU,
865868
*
866869
* Return optimal workspace in WORK(1)
867870
*
868-
WORK( 1 ) = DCMPLX( DBLE( MAXWRK ), ZERO )
871+
WORK( 1 ) = CMPLX( DBLE( MAXWRK ), ZERO, KIND=DP )
869872
*
870873
RETURN
871874
*

‎lapack-netlib/TESTING/EIG/cdrvmr3.f‎

Lines changed: 19 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -439,7 +439,7 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
439439
CHARACTER JOBQ, JOBU, JOBVT, RANGE
440440
INTEGER I, IINFO, IJQ, IJU, IJVT, IL, IU, ITEMP,
441441
$ IWSPC, IWTMP, J, JSIZE, JTYPE, LSWORK, M,
442-
$ MINWRK, MMAX, MNMAX, MNMIN, MTYPES, N,
442+
$ MINWRK, MMAX, MNMAX, MNMIN, MNTHR, MTYPES, N,
443443
$ NERRS, NFAIL, NMAX, NS, NSI, NSV, NTEST,
444444
$ NTESTF, NTESTT, LRWORK
445445
REAL ANORM, DIF, DIV, OVFL, RTUNFL, ULP, ULPINV,
@@ -454,8 +454,9 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
454454
REAL RESULT( 13 )
455455
* ..
456456
* .. External Functions ..
457+
INTEGER ILAENV
457458
REAL SLAMCH, SLARND, CLANGE
458-
EXTERNAL SLAMCH, SLARND, CLANGE
459+
EXTERNAL ILAENV, SLAMCH, SLARND, CLANGE
459460
* ..
460461
* .. External Subroutines ..
461462
EXTERNAL ALASVM, XERBLA, CBDT01, CBDT05, CGESDD,
@@ -552,6 +553,18 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
552553
M = MM( JSIZE )
553554
N = NN( JSIZE )
554555
MNMIN = MIN( M, N )
556+
*
557+
* Minimal workspace for CGESVDMR3, see LWORK there
558+
*
559+
IWTMP = 1
560+
IF( MNMIN.GT.0 ) THEN
561+
MNTHR = ILAENV( 6, 'CGESVD', 'VV', M, N, 0, 0 )
562+
IF( MAX( M, N ).GE.MNTHR ) THEN
563+
IWTMP = MNMIN*( MNMIN+5 )
564+
ELSE
565+
IWTMP = 3*MNMIN + MAX( M, N )
566+
END IF
567+
END IF
555568
*
556569
IF( NSIZES.NE.1 ) THEN
557570
MTYPES = MIN( MAXTYP, NTYPES )
@@ -624,9 +637,6 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
624637
*
625638
DO 290 IWSPC = 1, 4
626639
*
627-
* Test for CGESVD
628-
*
629-
IWTMP = 2*MIN( M, N )+MAX( M, N )
630640
LSWORK = IWTMP + ( IWSPC-1 )*( LWORK-IWTMP ) / 3
631641
LSWORK = MIN( LSWORK, LWORK )
632642
LSWORK = MAX( LSWORK, 1 )
@@ -645,7 +655,7 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
645655
SRNAMT = 'CGESVDMR3'
646656
CALL CGESVDMR3( 'V', 'V', 'A', M, N, A, LDA,
647657
$ VL, VU, IL, IU, NS, SSAV, USAV, LDU,
648-
$ VTSAV, LDVT, WORK, LWORK, RWORK,
658+
$ VTSAV, LDVT, WORK, LSWORK, RWORK,
649659
$ IWORK, IINFO )
650660
IF( IINFO.NE.0 ) THEN
651661
WRITE( NOUNIT, FMT = 9995 )'GESVDMR3', IINFO, M, N,
@@ -695,7 +705,7 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
695705
SRNAMT = 'CGESVDMR3'
696706
CALL CGESVDMR3( JOBU, JOBVT, 'A', M, N, A, LDA,
697707
$ VL, VU, IL, IU, NS, S, U, LDU,
698-
$ VT, LDVT, WORK, LWORK, RWORK,
708+
$ VT, LDVT, WORK, LSWORK, RWORK,
699709
$ IWORK, IINFO )
700710
*
701711
* Compare U
@@ -759,7 +769,7 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
759769
SRNAMT = 'CGESVDMR3'
760770
CALL CGESVDMR3( 'V', 'V', 'I', M, N, A, LDA,
761771
$ VL, VU, IL, IU, NSI, S, U, LDU,
762-
$ VT, LDVT, WORK, LWORK, RWORK,
772+
$ VT, LDVT, WORK, LSWORK, RWORK,
763773
$ IWORK, IINFO )
764774
IF( IINFO.NE.0 ) THEN
765775
WRITE( NOUNIT, FMT = 9995 )'GESVDMR3', IINFO, M, N,
@@ -819,7 +829,7 @@ SUBROUTINE CDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
819829
SRNAMT = 'CGESVDMR3'
820830
CALL CGESVDMR3( 'V', 'V', 'V', M, N, A, LDA,
821831
$ VL, VU, IL, IU, NSV, S, U, LDU,
822-
$ VT, LDVT, WORK, LWORK, RWORK,
832+
$ VT, LDVT, WORK, LSWORK, RWORK,
823833
$ IWORK, IINFO )
824834
IF( IINFO.NE.0 ) THEN
825835
WRITE( NOUNIT, FMT = 9995 )'GESVDMR3', IINFO, M, N,

‎lapack-netlib/TESTING/EIG/ddrvmr3.f‎

Lines changed: 26 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -401,7 +401,7 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
401401
CHARACTER*3 PATH
402402
INTEGER I, IINFO, IJQ, IJU, IJVT, IL,IU, IWS, IWTMP,
403403
$ ITEMP, J, JSIZE, JTYPE, LSWORK, M, MINWRK,
404-
$ MMAX, MNMAX, MNMIN, MTYPES, N, NFAIL,
404+
$ MMAX, MNMAX, MNMIN, MNTHR, MTYPES, N, NFAIL,
405405
$ NMAX, NS, NSI, NSV, NTEST
406406
DOUBLE PRECISION ANORM, DIF, DIV, OVFL, RTUNFL, ULP,
407407
$ ULPINV, UNFL, VL, VU
@@ -418,8 +418,9 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
418418
DOUBLE PRECISION RESULT( 13 )
419419
* ..
420420
* .. External Functions ..
421+
INTEGER ILAENV
421422
DOUBLE PRECISION DLAMCH, DLARND, DLANGE
422-
EXTERNAL DLAMCH, DLARND, DLANGE
423+
EXTERNAL ILAENV, DLAMCH, DLARND, DLANGE
423424
* ..
424425
* .. External Subroutines ..
425426
EXTERNAL ALASVM, DBDT01, DGEJSV, DGESDD, DGESVD,
@@ -511,6 +512,19 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
511512
M = MM( JSIZE )
512513
N = NN( JSIZE )
513514
MNMIN = MIN( M, N )
515+
*
516+
* Minimal workspace for DGESVDMR3, see LWORK there
517+
*
518+
IWTMP = 1
519+
IF( MNMIN.GT.0 ) THEN
520+
MNTHR = ILAENV( 6, 'DGESVD', 'VV', M, N, 0, 0 )
521+
IF( MAX( M, N ).GE.MNTHR ) THEN
522+
IWTMP = 8*MNMIN*MNMIN + 43*MNMIN
523+
ELSE
524+
IWTMP = MAX( 7*MNMIN*MNMIN + 42*MNMIN,
525+
$ 5*MNMIN*MNMIN + 27*MNMIN + MAX( M, N ) )
526+
END IF
527+
END IF
514528
*
515529
IF( NSIZES.NE.1 ) THEN
516530
MTYPES = MIN( MAXTYP, NTYPES )
@@ -581,6 +595,12 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
581595
* Do for minimal and adequate (for blocking) workspace
582596
*
583597
DO 220 IWS = 1, 4
598+
*
599+
LSWORK = IWTMP + ( IWS-1 )*( LWORK-IWTMP ) / 3
600+
LSWORK = MIN( LSWORK, LWORK )
601+
LSWORK = MAX( LSWORK, 1 )
602+
IF( IWS.EQ.4 )
603+
$ LSWORK = LWORK
584604
*
585605
DO 40 J = 1, 13
586606
RESULT( J ) = -ONE
@@ -591,7 +611,7 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
591611
CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
592612
CALL DGESVDMR3( 'V', 'V', 'A', M, N, A, LDA,
593613
$ VL, VU, IL, IU, NS, SSAV, USAV, LDU,
594-
$ VTSAV, LDVT, WORK, LWORK, IWORK,
614+
$ VTSAV, LDVT, WORK, LSWORK, IWORK,
595615
$ IINFO )
596616
IF( IINFO.NE.0 ) THEN
597617
WRITE( NOUT, FMT = 9995 )'GESVDMR3', IINFO, M, N,
@@ -642,7 +662,7 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
642662
CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
643663
CALL DGESVDMR3( JOBU, JOBVT, RANGE, M, N, A, LDA,
644664
$ VL, VU, IL, IU, NS, S, U, LDU,
645-
$ VT, LDVT, WORK, LWORK, IWORK,
665+
$ VT, LDVT, WORK, LSWORK, IWORK,
646666
$ IINFO )
647667
*
648668
* Compare U
@@ -704,7 +724,7 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
704724
CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
705725
CALL DGESVDMR3( 'V', 'V', 'I', M, N, A, LDA,
706726
$ VL, VU, IL, IU, NSI, S, U, LDU,
707-
$ VT, LDVT, WORK, LWORK, IWORK,
727+
$ VT, LDVT, WORK, LSWORK, IWORK,
708728
$ IINFO )
709729
IF( IINFO.NE.0 ) THEN
710730
WRITE( NOUT, FMT = 9995 )'GESVDMR3', IINFO, M, N,
@@ -761,7 +781,7 @@ SUBROUTINE DDRVMR3( NSIZES, MM, NN, NTYPES, DOTYPE, ISEED, THRESH,
761781
CALL DLACPY( 'F', M, N, ASAV, LDA, A, LDA )
762782
CALL DGESVDMR3( 'V', 'V', 'V', M, N, A, LDA,
763783
$ VL, VU, IL, IU, NSV, S, U, LDU,
764-
$ VT, LDVT, WORK, LWORK, IWORK,
784+
$ VT, LDVT, WORK, LSWORK, IWORK,
765785
$ IINFO )
766786
IF( IINFO.NE.0 ) THEN
767787
WRITE( NOUT, FMT = 9995 )'GESVDMR3', IINFO, M, N,

0 commit comments

Comments
 (0)