Skip to content

Commit 100988f

Browse files
martin-frbgmartin-frbg
authored
Merge branch 'OpenMathLib:develop' into lapack1286
2 parents ea007b5 + 3cdf5dc commit 100988f

48 files changed

Lines changed: 866 additions & 471 deletions

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎lapack-netlib/LAPACKE/src/lapacke_cgesvd_work.c‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -69,17 +69,19 @@ lapack_int LAPACKE_cgesvd_work( int matrix_layout, char jobu, char jobvt,
6969
LAPACKE_xerbla( "LAPACKE_cgesvd_work", info );
7070
return info;
7171
}
72-
if( ldu < ncols_u ) {
73-
info = -10;
74-
LAPACKE_xerbla( "LAPACKE_cgesvd_work", info );
75-
return info;
72+
if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
73+
if( ldu < ncols_u ) {
74+
info = -10;
75+
LAPACKE_xerbla( "LAPACKE_cgesvd_work", info );
76+
return info;
77+
}
7678
}
7779
if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
78-
if( ldvt < ncols_vt ) {
79-
info = -12;
80-
LAPACKE_xerbla( "LAPACKE_cgesvd_work", info );
81-
return info;
82-
}
80+
if( ldvt < ncols_vt ) {
81+
info = -12;
82+
LAPACKE_xerbla( "LAPACKE_cgesvd_work", info );
83+
return info;
84+
}
8385
}
8486
/* Query optimal working array(s) size if requested */
8587
if( lwork == -1 ) {

‎lapack-netlib/LAPACKE/src/lapacke_ctprfb_work.c‎

Lines changed: 31 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -50,16 +50,26 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans,
5050
info = info - 1;
5151
}
5252
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
53-
lapack_int lda_t = MAX(1,k);
53+
lapack_int nrowsA, ncolsA, nrowsV;
54+
if( LAPACKE_lsame(side, 'l') ) {
55+
nrowsA = k; ncolsA = n; nrowsV = m;
56+
} else if( LAPACKE_lsame(side, 'r') ) {
57+
nrowsA = m; ncolsA = k; nrowsV = n;
58+
} else {
59+
info = -2;
60+
LAPACKE_xerbla( "LAPACKE_ctprfb_work", info );
61+
return info;
62+
}
63+
lapack_int lda_t = MAX(1,nrowsA);
5464
lapack_int ldb_t = MAX(1,m);
5565
lapack_int ldt_t = MAX(1,ldt);
56-
lapack_int ldv_t = MAX(1,ldv);
66+
lapack_int ldv_t = MAX(1,nrowsV);
5767
lapack_complex_float* v_t = NULL;
5868
lapack_complex_float* t_t = NULL;
5969
lapack_complex_float* a_t = NULL;
6070
lapack_complex_float* b_t = NULL;
6171
/* Check leading dimension(s) */
62-
if( lda < m ) {
72+
if( lda < ncolsA ) {
6373
info = -15;
6474
LAPACKE_xerbla( "LAPACKE_ctprfb_work", info );
6575
return info;
@@ -74,10 +84,18 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans,
7484
LAPACKE_xerbla( "LAPACKE_ctprfb_work", info );
7585
return info;
7686
}
77-
if( ldv < k ) {
78-
info = -11;
79-
LAPACKE_xerbla( "LAPACKE_ctprfb_work", info );
80-
return info;
87+
if( LAPACKE_lsame(storev, 'c') ) {
88+
if( ldv < nrowsV ) {
89+
info = -11;
90+
LAPACKE_xerbla( "LAPACKE_ctprfb_work", info );
91+
return info;
92+
}
93+
} else {
94+
if( ldv < k ) {
95+
info = -11;
96+
LAPACKE_xerbla( "LAPACKE_ctprfb_work", info );
97+
return info;
98+
}
8199
}
82100
/* Allocate memory for temporary array(s) */
83101
v_t = (lapack_complex_float*)
@@ -93,7 +111,7 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans,
93111
goto exit_level_1;
94112
}
95113
a_t = (lapack_complex_float*)
96-
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) );
114+
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,ncolsA) );
97115
if( a_t == NULL ) {
98116
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
99117
goto exit_level_2;
@@ -105,17 +123,17 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans,
105123
goto exit_level_3;
106124
}
107125
/* Transpose input matrices */
108-
LAPACKE_cge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
109-
LAPACKE_cge_trans( matrix_layout, ldt, k, t, ldt, t_t, ldt_t );
110-
LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
111-
LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
126+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
127+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, ldt, k, t, ldt, t_t, ldt_t );
128+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
129+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
112130
/* Call LAPACK function and adjust info */
113131
LAPACK_ctprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t,
114132
&ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work,
115133
&ldwork );
116134
info = 0; /* LAPACK call is ok! */
117135
/* Transpose output matrices */
118-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
136+
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
119137
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
120138
/* Release memory and exit */
121139
LAPACKE_free( b_t );

‎lapack-netlib/LAPACKE/src/lapacke_dgesvd_work.c‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -67,17 +67,19 @@ lapack_int LAPACKE_dgesvd_work( int matrix_layout, char jobu, char jobvt,
6767
LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
6868
return info;
6969
}
70-
if( ldu < ncols_u ) {
71-
info = -10;
72-
LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
73-
return info;
70+
if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
71+
if( ldu < ncols_u ) {
72+
info = -10;
73+
LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
74+
return info;
75+
}
7476
}
7577
if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
76-
if( ldvt < ncols_vt ) {
77-
info = -12;
78-
LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
79-
return info;
80-
}
78+
if( ldvt < ncols_vt ) {
79+
info = -12;
80+
LAPACKE_xerbla( "LAPACKE_dgesvd_work", info );
81+
return info;
82+
}
8183
}
8284
/* Query optimal working array(s) size if requested */
8385
if( lwork == -1 ) {

‎lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c‎

Lines changed: 31 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -49,16 +49,26 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans,
4949
info = info - 1;
5050
}
5151
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
52-
lapack_int lda_t = MAX(1,k);
52+
lapack_int nrowsA, ncolsA, nrowsV;
53+
if( LAPACKE_lsame(side, 'l') ) {
54+
nrowsA = k; ncolsA = n; nrowsV = m;
55+
} else if( LAPACKE_lsame(side, 'r') ) {
56+
nrowsA = m; ncolsA = k; nrowsV = n;
57+
} else {
58+
info = -2;
59+
LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
60+
return info;
61+
}
62+
lapack_int lda_t = MAX(1,nrowsA);
5363
lapack_int ldb_t = MAX(1,m);
5464
lapack_int ldt_t = MAX(1,ldt);
55-
lapack_int ldv_t = MAX(1,ldv);
65+
lapack_int ldv_t = MAX(1,nrowsV);
5666
double* v_t = NULL;
5767
double* t_t = NULL;
5868
double* a_t = NULL;
5969
double* b_t = NULL;
6070
/* Check leading dimension(s) */
61-
if( lda < m ) {
71+
if( lda < ncolsA ) {
6272
info = -15;
6373
LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
6474
return info;
@@ -73,10 +83,18 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans,
7383
LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
7484
return info;
7585
}
76-
if( ldv < k ) {
77-
info = -11;
78-
LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
79-
return info;
86+
if( LAPACKE_lsame(storev, 'c') ) {
87+
if( ldv < nrowsV ) {
88+
info = -11;
89+
LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
90+
return info;
91+
}
92+
} else {
93+
if( ldv < k ) {
94+
info = -11;
95+
LAPACKE_xerbla( "LAPACKE_dtprfb_work", info );
96+
return info;
97+
}
8098
}
8199
/* Allocate memory for temporary array(s) */
82100
v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,k) );
@@ -89,7 +107,7 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans,
89107
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
90108
goto exit_level_1;
91109
}
92-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
110+
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,ncolsA) );
93111
if( a_t == NULL ) {
94112
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
95113
goto exit_level_2;
@@ -100,17 +118,17 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans,
100118
goto exit_level_3;
101119
}
102120
/* Transpose input matrices */
103-
LAPACKE_dge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
104-
LAPACKE_dge_trans( matrix_layout, ldt, k, t, ldt, t_t, ldt_t );
105-
LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
106-
LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
121+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
122+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, ldt, k, t, ldt, t_t, ldt_t );
123+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
124+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
107125
/* Call LAPACK function and adjust info */
108126
LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t,
109127
&ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work,
110128
&ldwork );
111129
info = 0; /* LAPACK call is ok! */
112130
/* Transpose output matrices */
113-
LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
131+
LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
114132
LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
115133
/* Release memory and exit */
116134
LAPACKE_free( b_t );

‎lapack-netlib/LAPACKE/src/lapacke_sgesvd_work.c‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -67,17 +67,19 @@ lapack_int LAPACKE_sgesvd_work( int matrix_layout, char jobu, char jobvt,
6767
LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
6868
return info;
6969
}
70-
if( ldu < ncols_u ) {
71-
info = -10;
72-
LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
73-
return info;
70+
if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
71+
if( ldu < ncols_u ) {
72+
info = -10;
73+
LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
74+
return info;
75+
}
7476
}
7577
if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
76-
if( ldvt < ncols_vt ) {
77-
info = -12;
78-
LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
79-
return info;
80-
}
78+
if( ldvt < ncols_vt ) {
79+
info = -12;
80+
LAPACKE_xerbla( "LAPACKE_sgesvd_work", info );
81+
return info;
82+
}
8183
}
8284
/* Query optimal working array(s) size if requested */
8385
if( lwork == -1 ) {

‎lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c‎

Lines changed: 31 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -49,16 +49,26 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans,
4949
info = info - 1;
5050
}
5151
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
52-
lapack_int lda_t = MAX(1,k);
52+
lapack_int nrowsA, ncolsA, nrowsV;
53+
if( LAPACKE_lsame(side, 'l') ) {
54+
nrowsA = k; ncolsA = n; nrowsV = m;
55+
} else if( LAPACKE_lsame(side, 'r') ) {
56+
nrowsA = m; ncolsA = k; nrowsV = n;
57+
} else {
58+
info = -2;
59+
LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
60+
return info;
61+
}
62+
lapack_int lda_t = MAX(1,nrowsA);
5363
lapack_int ldb_t = MAX(1,m);
5464
lapack_int ldt_t = MAX(1,ldt);
55-
lapack_int ldv_t = MAX(1,ldv);
65+
lapack_int ldv_t = MAX(1,nrowsV);
5666
float* v_t = NULL;
5767
float* t_t = NULL;
5868
float* a_t = NULL;
5969
float* b_t = NULL;
6070
/* Check leading dimension(s) */
61-
if( lda < m ) {
71+
if( lda < ncolsA ) {
6272
info = -15;
6373
LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
6474
return info;
@@ -73,10 +83,18 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans,
7383
LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
7484
return info;
7585
}
76-
if( ldv < k ) {
77-
info = -11;
78-
LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
79-
return info;
86+
if( LAPACKE_lsame(storev, 'c') ) {
87+
if( ldv < nrowsV ) {
88+
info = -11;
89+
LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
90+
return info;
91+
}
92+
} else {
93+
if( ldv < k ) {
94+
info = -11;
95+
LAPACKE_xerbla( "LAPACKE_stprfb_work", info );
96+
return info;
97+
}
8098
}
8199
/* Allocate memory for temporary array(s) */
82100
v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,k) );
@@ -89,7 +107,7 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans,
89107
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
90108
goto exit_level_1;
91109
}
92-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
110+
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,ncolsA) );
93111
if( a_t == NULL ) {
94112
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
95113
goto exit_level_2;
@@ -100,17 +118,17 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans,
100118
goto exit_level_3;
101119
}
102120
/* Transpose input matrices */
103-
LAPACKE_sge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
104-
LAPACKE_sge_trans( matrix_layout, ldt, k, t, ldt, t_t, ldt_t );
105-
LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
106-
LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
121+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
122+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, ldt, k, t, ldt, t_t, ldt_t );
123+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
124+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
107125
/* Call LAPACK function and adjust info */
108126
LAPACK_stprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t,
109127
&ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work,
110128
&ldwork );
111129
info = 0; /* LAPACK call is ok! */
112130
/* Transpose output matrices */
113-
LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
131+
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
114132
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
115133
/* Release memory and exit */
116134
LAPACKE_free( b_t );

‎lapack-netlib/LAPACKE/src/lapacke_zgesvd_work.c‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -69,17 +69,19 @@ lapack_int LAPACKE_zgesvd_work( int matrix_layout, char jobu, char jobvt,
6969
LAPACKE_xerbla( "LAPACKE_zgesvd_work", info );
7070
return info;
7171
}
72-
if( ldu < ncols_u ) {
73-
info = -10;
74-
LAPACKE_xerbla( "LAPACKE_zgesvd_work", info );
75-
return info;
72+
if( LAPACKE_lsame( jobu, 'a' ) || LAPACKE_lsame( jobu, 's' ) ) {
73+
if( ldu < ncols_u ) {
74+
info = -10;
75+
LAPACKE_xerbla( "LAPACKE_zgesvd_work", info );
76+
return info;
77+
}
7678
}
7779
if( LAPACKE_lsame( jobvt, 'a' ) || LAPACKE_lsame( jobvt, 's' ) ) {
78-
if( ldvt < ncols_vt ) {
79-
info = -12;
80-
LAPACKE_xerbla( "LAPACKE_zgesvd_work", info );
81-
return info;
82-
}
80+
if( ldvt < ncols_vt ) {
81+
info = -12;
82+
LAPACKE_xerbla( "LAPACKE_zgesvd_work", info );
83+
return info;
84+
}
8385
}
8486
/* Query optimal working array(s) size if requested */
8587
if( lwork == -1 ) {

0 commit comments

Comments
 (0)