Skip to content

Commit 18fbec6

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #6206 from martin-frbg/lapack1455
Return workspace for D/ZSTEDC via DROUNDUP_LWORK (Reference-LAPACK PR…
2 parents 47a9abb + 74579ad commit 18fbec6

4 files changed

Lines changed: 28 additions & 20 deletions

File tree

‎lapack-netlib/SRC/dstedc.c‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -485,6 +485,7 @@ f"> */
485485
logical lquery;
486486
integer smlsiz, storez, strtrw, lgn;
487487
doublereal eps;
488+
extern doublereal droundup_lwork__(integer *);
488489

489490

490491
/* -- LAPACK computational routine (version 3.7.1) -- */
@@ -560,7 +561,7 @@ f"> */
560561
liwmin = *n * 5 + 3;
561562
}
562563
}
563-
work[1] = (doublereal) lwmin;
564+
work[1] = droundup_lwork__( &lwmin );
564565
iwork[1] = liwmin;
565566

566567
if (*lwork < lwmin && ! lquery) {
@@ -766,7 +767,7 @@ f"> */
766767
}
767768

768769
L50:
769-
work[1] = (doublereal) lwmin;
770+
work[1] = droundup_lwork__( &lwmin );
770771
iwork[1] = liwmin;
771772

772773
return;

‎lapack-netlib/SRC/dstedc.f‎

Lines changed: 17 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,13 @@
55
* Online html documentation available at
66
* http://www.netlib.org/lapack/explore-html/
77
*
8-
*> \htmlonly
98
*> Download DSTEDC + dependencies
109
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dstedc.f">
1110
*> [TGZ]</a>
1211
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dstedc.f">
1312
*> [ZIP]</a>
1413
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dstedc.f">
1514
*> [TXT]</a>
16-
*> \endhtmlonly
1715
*
1816
* Definition:
1917
* ===========
@@ -167,7 +165,7 @@
167165
*> \author Univ. of Colorado Denver
168166
*> \author NAG Ltd.
169167
*
170-
*> \ingroup auxOTHERcomputational
168+
*> \ingroup stedc
171169
*
172170
*> \par Contributors:
173171
* ==================
@@ -179,6 +177,7 @@
179177
* =====================================================================
180178
SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
181179
$ LIWORK, INFO )
180+
IMPLICIT NONE
182181
*
183182
* -- LAPACK computational routine --
184183
* -- LAPACK is a software package provided by Univ. of Tennessee, --
@@ -208,11 +207,13 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
208207
* .. External Functions ..
209208
LOGICAL LSAME
210209
INTEGER ILAENV
211-
DOUBLE PRECISION DLAMCH, DLANST
212-
EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
210+
DOUBLE PRECISION DLAMCH, DLANST, DROUNDUP_LWORK
211+
EXTERNAL LSAME, ILAENV, DLAMCH, DLANST,
212+
$ DROUNDUP_LWORK
213213
* ..
214214
* .. External Subroutines ..
215-
EXTERNAL DGEMM, DLACPY, DLAED0, DLASCL, DLASET, DLASRT,
215+
EXTERNAL DGEMM, DLACPY, DLAED0, DLASCL, DLASET,
216+
$ DLASRT,
216217
$ DSTEQR, DSTERF, DSWAP, XERBLA
217218
* ..
218219
* .. Intrinsic Functions ..
@@ -268,7 +269,7 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
268269
LIWMIN = 3 + 5*N
269270
END IF
270271
END IF
271-
WORK( 1 ) = LWMIN
272+
WORK( 1 ) = DROUNDUP_LWORK(LWMIN)
272273
IWORK( 1 ) = LIWMIN
273274
*
274275
IF( LWORK.LT.LWMIN .AND. .NOT. LQUERY ) THEN
@@ -377,9 +378,11 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
377378
* Scale.
378379
*
379380
ORGNRM = DLANST( 'M', M, D( START ), E( START ) )
380-
CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ), M,
381+
CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M, 1, D( START ),
382+
$ M,
381383
$ INFO )
382-
CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1, E( START ),
384+
CALL DLASCL( 'G', 0, 0, ORGNRM, ONE, M-1, 1,
385+
$ E( START ),
383386
$ M-1, INFO )
384387
*
385388
IF( ICOMPZ.EQ.1 ) THEN
@@ -398,7 +401,8 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
398401
*
399402
* Scale back.
400403
*
401-
CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ), M,
404+
CALL DLASCL( 'G', 0, 0, ONE, ORGNRM, M, 1, D( START ),
405+
$ M,
402406
$ INFO )
403407
*
404408
ELSE
@@ -408,7 +412,8 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
408412
* the length of D, we must solve the sub-problem in a
409413
* workspace and then multiply back into Z.
410414
*
411-
CALL DSTEQR( 'I', M, D( START ), E( START ), WORK, M,
415+
CALL DSTEQR( 'I', M, D( START ), E( START ), WORK,
416+
$ M,
412417
$ WORK( M*M+1 ), INFO )
413418
CALL DLACPY( 'A', N, M, Z( 1, START ), LDZ,
414419
$ WORK( STOREZ ), N )
@@ -463,7 +468,7 @@ SUBROUTINE DSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, IWORK,
463468
END IF
464469
*
465470
50 CONTINUE
466-
WORK( 1 ) = LWMIN
471+
WORK( 1 ) = DROUNDUP_LWORK(LWMIN)
467472
IWORK( 1 ) = LIWMIN
468473
*
469474
RETURN

‎lapack-netlib/SRC/zstedc.c‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -545,6 +545,7 @@ f"> */
545545
doublereal *, doublecomplex *, integer *, doublereal *, integer *);
546546
integer lgn;
547547
doublereal eps;
548+
extern doublereal droundup_lwork__(integer *);
548549

549550

550551
/* -- LAPACK computational routine (version 3.7.1) -- */
@@ -623,7 +624,7 @@ f"> */
623624
lrwmin = (*n << 2) + 1 + (i__1 * i__1 << 1);
624625
liwmin = *n * 5 + 3;
625626
}
626-
work[1].r = (doublereal) lwmin, work[1].i = 0.;
627+
work[1].r = droundup_lwork__( &lwmin ), work[1].i = 0.;
627628
rwork[1] = (doublereal) lrwmin;
628629
iwork[1] = liwmin;
629630

@@ -815,7 +816,7 @@ f"> */
815816
}
816817

817818
L70:
818-
work[1].r = (doublereal) lwmin, work[1].i = 0.;
819+
work[1].r = droundup_lwork__( &lwmin ), work[1].i = 0.;
819820
rwork[1] = (doublereal) lrwmin;
820821
iwork[1] = liwmin;
821822

‎lapack-netlib/SRC/zstedc.f‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -232,8 +232,9 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
232232
* .. External Functions ..
233233
LOGICAL LSAME
234234
INTEGER ILAENV
235-
DOUBLE PRECISION DLAMCH, DLANST
236-
EXTERNAL LSAME, ILAENV, DLAMCH, DLANST
235+
DOUBLE PRECISION DLAMCH, DLANST, DROUNDUP_LWORK
236+
EXTERNAL LSAME, ILAENV, DLAMCH, DLANST,
237+
$ DROUNDUP_LWORK
237238
* ..
238239
* .. External Subroutines ..
239240
EXTERNAL DLASCL, DLASET, DSTEDC, DSTEQR, DSTERF,
@@ -295,7 +296,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
295296
LRWMIN = 1 + 4*N + 2*N**2
296297
LIWMIN = 3 + 5*N
297298
END IF
298-
WORK( 1 ) = LWMIN
299+
WORK( 1 ) = DROUNDUP_LWORK(LWMIN)
299300
RWORK( 1 ) = DBLE( LRWMIN )
300301
IWORK( 1 ) = LIWMIN
301302
*
@@ -471,7 +472,7 @@ SUBROUTINE ZSTEDC( COMPZ, N, D, E, Z, LDZ, WORK, LWORK, RWORK,
471472
END IF
472473
*
473474
70 CONTINUE
474-
WORK( 1 ) = LWMIN
475+
WORK( 1 ) = DROUNDUP_LWORK(LWMIN)
475476
RWORK( 1 ) = DBLE( LRWMIN )
476477
IWORK( 1 ) = LIWMIN
477478
*

0 commit comments

Comments
 (0)