Skip to content

Commit 67ab142

Browse files
martin-frbgmartin-frbg
authored
Merge pull request #4 from Reference-LAPACK/master
rebase
2 parents a69969d + 0148a36 commit 67ab142

18 files changed

Lines changed: 243 additions & 155 deletions

‎LAPACKE/include/lapack.h‎

Lines changed: 124 additions & 84 deletions
Original file line numberDiff line numberDiff line change
@@ -12,27 +12,6 @@
1212

1313
#include <stdlib.h>
1414

15-
#ifdef __cplusplus
16-
extern "C" {
17-
#endif
18-
19-
/*----------------------------------------------------------------------------*/
20-
#ifndef lapack_int
21-
#define lapack_int int
22-
#endif
23-
24-
#ifndef lapack_logical
25-
#define lapack_logical lapack_int
26-
#endif
27-
28-
/* f2c, hence clapack and MacOS Accelerate, returns double instead of float
29-
* for sdot, slange, clange, etc. */
30-
#if defined(LAPACK_F2C)
31-
typedef double lapack_float_return;
32-
#else
33-
typedef float lapack_float_return;
34-
#endif
35-
3615
/* Complex types are structures equivalent to the
3716
* Fortran complex types COMPLEX(4) and COMPLEX(8).
3817
*
@@ -52,7 +31,11 @@ extern "C" {
5231

5332
/* Complex type (single precision) */
5433
#ifndef lapack_complex_float
34+
#ifndef __cplusplus
5535
#include <complex.h>
36+
#else
37+
#include <complex>
38+
#endif
5639
#define lapack_complex_float float _Complex
5740
#endif
5841

@@ -66,7 +49,11 @@ extern "C" {
6649

6750
/* Complex type (double precision) */
6851
#ifndef lapack_complex_double
52+
#ifndef __cplusplus
6953
#include <complex.h>
54+
#else
55+
#include <complex>
56+
#endif
7057
#define lapack_complex_double double _Complex
7158
#endif
7259

@@ -80,6 +67,29 @@ extern "C" {
8067

8168
#endif /* LAPACK_COMPLEX_CUSTOM */
8269

70+
71+
#ifdef __cplusplus
72+
extern "C" {
73+
#endif
74+
75+
/*----------------------------------------------------------------------------*/
76+
#ifndef lapack_int
77+
#define lapack_int int
78+
#endif
79+
80+
#ifndef lapack_logical
81+
#define lapack_logical lapack_int
82+
#endif
83+
84+
/* f2c, hence clapack and MacOS Accelerate, returns double instead of float
85+
* for sdot, slange, clange, etc. */
86+
#if defined(LAPACK_F2C)
87+
typedef double lapack_float_return;
88+
#else
89+
typedef float lapack_float_return;
90+
#endif
91+
92+
8393
/* Callback logical functions of one, two, or three arguments are used
8494
* to select eigenvalues to sort to the top left of the Schur form.
8595
* The value is selected if function returns TRUE (non-zero). */
@@ -2503,7 +2513,7 @@ void LAPACK_zgesvdq(
25032513
lapack_complex_double* U, lapack_int const* ldu,
25042514
lapack_complex_double* V, lapack_int const* ldv, lapack_int* numrank,
25052515
lapack_int* iwork, lapack_int const* liwork,
2506-
lapack_complex_float* cwork, lapack_int* lcwork,
2516+
lapack_complex_double* cwork, lapack_int* lcwork,
25072517
double* rwork, lapack_int const* lrwork,
25082518
lapack_int* info );
25092519

@@ -3640,45 +3650,58 @@ void LAPACK_zggrqf(
36403650
lapack_int* info );
36413651

36423652
#define LAPACK_sggsvd LAPACK_GLOBAL(sggsvd,SGGSVD)
3643-
lapack_int LAPACKE_sggsvd( int matrix_layout, char jobu, char jobv, char jobq,
3644-
lapack_int m, lapack_int n, lapack_int p,
3645-
lapack_int* k, lapack_int* l, float* a,
3646-
lapack_int lda, float* b, lapack_int ldb,
3647-
float* alpha, float* beta, float* u, lapack_int ldu,
3648-
float* v, lapack_int ldv, float* q, lapack_int ldq,
3649-
lapack_int* iwork );
3653+
lapack_int LAPACK_sggsvd(
3654+
char const* jobu, char const* jobv, char const* jobq,
3655+
lapack_int const* m, lapack_int const* n, lapack_int const* p,
3656+
lapack_int* k, lapack_int* l,
3657+
float* a, lapack_int const* lda,
3658+
float* b, lapack_int const* ldb,
3659+
float* alpha, float* beta,
3660+
float* u, lapack_int const* ldu,
3661+
float* v, lapack_int const* ldv,
3662+
float* q, lapack_int const* ldq,
3663+
float* work, lapack_int* iwork, lapack_int* info );
36503664

36513665
#define LAPACK_dggsvd LAPACK_GLOBAL(dggsvd,DGGSVD)
3652-
lapack_int LAPACKE_dggsvd( int matrix_layout, char jobu, char jobv, char jobq,
3653-
lapack_int m, lapack_int n, lapack_int p,
3654-
lapack_int* k, lapack_int* l, double* a,
3655-
lapack_int lda, double* b, lapack_int ldb,
3656-
double* alpha, double* beta, double* u,
3657-
lapack_int ldu, double* v, lapack_int ldv, double* q,
3658-
lapack_int ldq, lapack_int* iwork );
3666+
lapack_int LAPACK_dggsvd(
3667+
char const* jobu, char const* jobv, char const* jobq,
3668+
lapack_int const* m, lapack_int const* n, lapack_int const* p,
3669+
lapack_int* k, lapack_int* l,
3670+
double* a, lapack_int const* lda,
3671+
double* b, lapack_int const* ldb,
3672+
double* alpha, double* beta,
3673+
double* u, lapack_int const* ldu,
3674+
double* v, lapack_int const* ldv,
3675+
double* q, lapack_int const* ldq,
3676+
double* work, lapack_int* iwork, lapack_int* info );
36593677

36603678
#define LAPACK_cggsvd LAPACK_GLOBAL(cggsvd,CGGSVD)
3661-
lapack_int LAPACKE_cggsvd( int matrix_layout, char jobu, char jobv, char jobq,
3662-
lapack_int m, lapack_int n, lapack_int p,
3663-
lapack_int* k, lapack_int* l,
3664-
lapack_complex_float* a, lapack_int lda,
3665-
lapack_complex_float* b, lapack_int ldb,
3666-
float* alpha, float* beta, lapack_complex_float* u,
3667-
lapack_int ldu, lapack_complex_float* v,
3668-
lapack_int ldv, lapack_complex_float* q,
3669-
lapack_int ldq, lapack_int* iwork );
3679+
lapack_int LAPACK_cggsvd(
3680+
char const* jobu, char const* jobv, char const* jobq,
3681+
lapack_int const* m, lapack_int const* n, lapack_int const* p,
3682+
lapack_int* k, lapack_int* l,
3683+
lapack_complex_float* a, lapack_int const* lda,
3684+
lapack_complex_float* b, lapack_int const* ldb,
3685+
float* alpha, float* beta,
3686+
lapack_complex_float* u, lapack_int const* ldu,
3687+
lapack_complex_float* v, lapack_int const* ldv,
3688+
lapack_complex_float* q, lapack_int const* ldq,
3689+
lapack_complex_float* work, float* rwork,
3690+
lapack_int* iwork, lapack_int* info );
36703691

36713692
#define LAPACK_zggsvd LAPACK_GLOBAL(zggsvd,ZGGSVD)
3672-
lapack_int LAPACKE_zggsvd( int matrix_layout, char jobu, char jobv, char jobq,
3673-
lapack_int m, lapack_int n, lapack_int p,
3674-
lapack_int* k, lapack_int* l,
3675-
lapack_complex_double* a, lapack_int lda,
3676-
lapack_complex_double* b, lapack_int ldb,
3677-
double* alpha, double* beta,
3678-
lapack_complex_double* u, lapack_int ldu,
3679-
lapack_complex_double* v, lapack_int ldv,
3680-
lapack_complex_double* q, lapack_int ldq,
3681-
lapack_int* iwork );
3693+
lapack_int LAPACK_zggsvd(
3694+
char const* jobu, char const* jobv, char const* jobq,
3695+
lapack_int const* m, lapack_int const* n, lapack_int const* p,
3696+
lapack_int* k, lapack_int* l,
3697+
lapack_complex_double* a, lapack_int const* lda,
3698+
lapack_complex_double* b, lapack_int const* ldb,
3699+
double* alpha, double* beta,
3700+
lapack_complex_double* u, lapack_int const* ldu,
3701+
lapack_complex_double* v, lapack_int const* ldv,
3702+
lapack_complex_double* q, lapack_int const* ldq,
3703+
lapack_complex_double* work, double* rwork,
3704+
lapack_int* iwork, lapack_int* info );
36823705

36833706
#define LAPACK_cggsvd3 LAPACK_GLOBAL(cggsvd3,CGGSVD3)
36843707
void LAPACK_cggsvd3(
@@ -3743,41 +3766,58 @@ void LAPACK_zggsvd3(
37433766
lapack_int* info );
37443767

37453768
#define LAPACK_sggsvp LAPACK_GLOBAL(sggsvp,SGGSVP)
3746-
lapack_int LAPACKE_sggsvp( int matrix_layout, char jobu, char jobv, char jobq,
3747-
lapack_int m, lapack_int p, lapack_int n, float* a,
3748-
lapack_int lda, float* b, lapack_int ldb, float tola,
3749-
float tolb, lapack_int* k, lapack_int* l, float* u,
3750-
lapack_int ldu, float* v, lapack_int ldv, float* q,
3751-
lapack_int ldq );
3769+
lapack_int LAPACK_sggsvp(
3770+
char const* jobu, char const* jobv, char const* jobq,
3771+
lapack_int const* m, lapack_int const* p, lapack_int const* n,
3772+
float* a, lapack_int const* lda,
3773+
float* b, lapack_int const* ldb,
3774+
float* tola, float* tolb,
3775+
lapack_int* k, lapack_int* l,
3776+
float* u, lapack_int const* ldu,
3777+
float* v, lapack_int const* ldv,
3778+
float* q, lapack_int const* ldq,
3779+
lapack_int* iwork, float* tau,
3780+
float* work, lapack_int* info );
37523781

37533782
#define LAPACK_dggsvp LAPACK_GLOBAL(dggsvp,DGGSVP)
3754-
lapack_int LAPACKE_dggsvp( int matrix_layout, char jobu, char jobv, char jobq,
3755-
lapack_int m, lapack_int p, lapack_int n, double* a,
3756-
lapack_int lda, double* b, lapack_int ldb,
3757-
double tola, double tolb, lapack_int* k,
3758-
lapack_int* l, double* u, lapack_int ldu, double* v,
3759-
lapack_int ldv, double* q, lapack_int ldq );
3783+
lapack_int LAPACK_dggsvp(
3784+
char const* jobu, char const* jobv, char const* jobq,
3785+
lapack_int const* m, lapack_int const* p, lapack_int const* n,
3786+
double* a, lapack_int const* lda,
3787+
double* b, lapack_int const* ldb,
3788+
double* tola, double* tolb,
3789+
lapack_int* k, lapack_int* l,
3790+
double* u, lapack_int const* ldu,
3791+
double* v, lapack_int const* ldv,
3792+
double* q, lapack_int const* ldq,
3793+
lapack_int* iwork, double* tau,
3794+
double* work, lapack_int* info );
37603795

37613796
#define LAPACK_cggsvp LAPACK_GLOBAL(cggsvp,CGGSVP)
3762-
lapack_int LAPACKE_cggsvp( int matrix_layout, char jobu, char jobv, char jobq,
3763-
lapack_int m, lapack_int p, lapack_int n,
3764-
lapack_complex_float* a, lapack_int lda,
3765-
lapack_complex_float* b, lapack_int ldb, float tola,
3766-
float tolb, lapack_int* k, lapack_int* l,
3767-
lapack_complex_float* u, lapack_int ldu,
3768-
lapack_complex_float* v, lapack_int ldv,
3769-
lapack_complex_float* q, lapack_int ldq );
3797+
lapack_int LAPACK_cggsvp(
3798+
char const* jobu, char const* jobv, char const* jobq,
3799+
lapack_int const* m, lapack_int const* p, lapack_int const* n,
3800+
lapack_complex_float* a, lapack_int const* lda,
3801+
lapack_complex_float* b, lapack_int const* ldb,
3802+
float* tola, float* tolb, lapack_int* k, lapack_int* l,
3803+
lapack_complex_float* u, lapack_int const* ldu,
3804+
lapack_complex_float* v, lapack_int const* ldv,
3805+
lapack_complex_float* q, lapack_int const* ldq,
3806+
lapack_int* iwork, float* rwork, lapack_complex_float* tau,
3807+
lapack_complex_float* work, lapack_int* info );
37703808

37713809
#define LAPACK_zggsvp LAPACK_GLOBAL(zggsvp,ZGGSVP)
3772-
lapack_int LAPACKE_zggsvp( int matrix_layout, char jobu, char jobv, char jobq,
3773-
lapack_int m, lapack_int p, lapack_int n,
3774-
lapack_complex_double* a, lapack_int lda,
3775-
lapack_complex_double* b, lapack_int ldb,
3776-
double tola, double tolb, lapack_int* k,
3777-
lapack_int* l, lapack_complex_double* u,
3778-
lapack_int ldu, lapack_complex_double* v,
3779-
lapack_int ldv, lapack_complex_double* q,
3780-
lapack_int ldq );
3810+
lapack_int LAPACK_zggsvp(
3811+
char const* jobu, char const* jobv, char const* jobq,
3812+
lapack_int const* m, lapack_int const* p, lapack_int const* n,
3813+
lapack_complex_double* a, lapack_int const* lda,
3814+
lapack_complex_double* b, lapack_int const* ldb,
3815+
double* tola, double* tolb, lapack_int* k, lapack_int* l,
3816+
lapack_complex_double* u, lapack_int const* ldu,
3817+
lapack_complex_double* v, lapack_int const* ldv,
3818+
lapack_complex_double* q, lapack_int const* ldq,
3819+
lapack_int* iwork, double* rwork, lapack_complex_double* tau,
3820+
lapack_complex_double* work, lapack_int* info );
37813821

37823822
#define LAPACK_cggsvp3 LAPACK_GLOBAL(cggsvp3,CGGSVP3)
37833823
void LAPACK_cggsvp3(

‎LAPACKE/src/lapacke_cgesvdq.c‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -47,8 +47,8 @@ lapack_int LAPACKE_cgesvdq( int matrix_layout, char joba, char jobp,
4747
lapack_complex_float* cwork = NULL;
4848
lapack_complex_float cwork_query;
4949
lapack_int lrwork = -1;
50-
double* rwork = NULL;
51-
double rwork_query;
50+
float* rwork = NULL;
51+
float rwork_query;
5252
lapack_int i;
5353
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
5454
LAPACKE_xerbla( "LAPACKE_cgesvdq", -1 );
@@ -84,7 +84,7 @@ lapack_int LAPACKE_cgesvdq( int matrix_layout, char joba, char jobp,
8484
info = LAPACK_WORK_MEMORY_ERROR;
8585
goto exit_level_0;
8686
}
87-
rwork = (double*)LAPACKE_malloc( sizeof(double) * lrwork );
87+
rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork );
8888
if( rwork == NULL ) {
8989
info = LAPACK_WORK_MEMORY_ERROR;
9090
goto exit_level_0;

‎SRC/cgelq.f‎

Lines changed: 20 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -187,7 +187,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
187187
* ..
188188
* .. Local Scalars ..
189189
LOGICAL LQUERY, LMINWS, MINT, MINW
190-
INTEGER MB, NB, MINTSZ, NBLCKS
190+
INTEGER MB, NB, MINTSZ, NBLCKS, LWMIN, LWOPT, LWREQ
191191
* ..
192192
* .. External Functions ..
193193
LOGICAL LSAME
@@ -243,20 +243,32 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
243243
*
244244
* Determine if the workspace size satisfies minimal size
245245
*
246+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
247+
LWMIN = MAX( 1, N )
248+
LWOPT = MAX( 1, MB*N )
249+
ELSE
250+
LWMIN = MAX( 1, M )
251+
LWOPT = MAX( 1, MB*M )
252+
END IF
246253
LMINWS = .FALSE.
247-
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.MB*M )
248-
$ .AND. ( LWORK.GE.M ) .AND. ( TSIZE.GE.MINTSZ )
254+
IF( ( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) .OR. LWORK.LT.LWOPT )
255+
$ .AND. ( LWORK.GE.LWMIN ) .AND. ( TSIZE.GE.MINTSZ )
249256
$ .AND. ( .NOT.LQUERY ) ) THEN
250257
IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 ) ) THEN
251258
LMINWS = .TRUE.
252259
MB = 1
253260
NB = N
254261
END IF
255-
IF( LWORK.LT.MB*M ) THEN
262+
IF( LWORK.LT.LWOPT ) THEN
256263
LMINWS = .TRUE.
257264
MB = 1
258265
END IF
259266
END IF
267+
IF( ( N.LE.M ) .OR. ( NB.LE.M ) .OR. ( NB.GE.N ) ) THEN
268+
LWREQ = MAX( 1, MB*N )
269+
ELSE
270+
LWREQ = MAX( 1, MB*M )
271+
END IF
260272
*
261273
IF( M.LT.0 ) THEN
262274
INFO = -1
@@ -267,7 +279,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
267279
ELSE IF( TSIZE.LT.MAX( 1, MB*M*NBLCKS + 5 )
268280
$ .AND. ( .NOT.LQUERY ) .AND. ( .NOT.LMINWS ) ) THEN
269281
INFO = -6
270-
ELSE IF( ( LWORK.LT.MAX( 1, M*MB ) ) .AND .( .NOT.LQUERY )
282+
ELSE IF( ( LWORK.LT.LWREQ ) .AND .( .NOT.LQUERY )
271283
$ .AND. ( .NOT.LMINWS ) ) THEN
272284
INFO = -8
273285
END IF
@@ -281,9 +293,9 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
281293
T( 2 ) = MB
282294
T( 3 ) = NB
283295
IF( MINW ) THEN
284-
WORK( 1 ) = MAX( 1, N )
296+
WORK( 1 ) = LWMIN
285297
ELSE
286-
WORK( 1 ) = MAX( 1, MB*M )
298+
WORK( 1 ) = LWREQ
287299
END IF
288300
END IF
289301
IF( INFO.NE.0 ) THEN
@@ -308,7 +320,7 @@ SUBROUTINE CGELQ( M, N, A, LDA, T, TSIZE, WORK, LWORK,
308320
$ LWORK, INFO )
309321
END IF
310322
*
311-
WORK( 1 ) = MAX( 1, MB*M )
323+
WORK( 1 ) = LWREQ
312324
*
313325
RETURN
314326
*

‎SRC/cgetsls.f‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -261,7 +261,7 @@ SUBROUTINE CGETSLS( TRANS, M, N, NRHS, A, LDA, B, LDB,
261261
TSZM = INT( TQ( 1 ) )
262262
LWM = INT( WORKQ( 1 ) )
263263
CALL CGEMLQ( 'L', TRANS, N, NRHS, M, A, LDA, TQ,
264-
$ TSZO, B, LDB, WORKQ, -1, INFO2 )
264+
$ TSZM, B, LDB, WORKQ, -1, INFO2 )
265265
LWM = MAX( LWM, INT( WORKQ( 1 ) ) )
266266
WSIZEO = TSZO + LWO
267267
WSIZEM = TSZM + LWM

0 commit comments

Comments
 (0)