Skip to content

Commit e94df53

Browse files
langoulangou
authored
Merge pull request Reference-LAPACK#540 from weslleyspereira/fix-404-LAPACKE-dtpmqrt
Fix error on LAPACKE_*tpmqrt_work for ROW MAJOR matrices
2 parents 28f7e83 + c9e0121 commit e94df53

4 files changed

+80
-48
lines changed

‎LAPACKE/src/lapacke_ctpmqrt_work.c

+20-12
Original file line numberDiff line numberDiff line change
@@ -50,16 +50,24 @@ lapack_int LAPACKE_ctpmqrt_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 ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
55+
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
56+
else {
57+
info = -2;
58+
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
59+
return info;
60+
}
61+
lapack_int lda_t = MAX(1,nrowsA);
5462
lapack_int ldb_t = MAX(1,m);
55-
lapack_int ldt_t = MAX(1,ldt);
56-
lapack_int ldv_t = MAX(1,ldv);
63+
lapack_int ldt_t = MAX(1,nb);
64+
lapack_int ldv_t = MAX(1,nrowsV);
5765
lapack_complex_float* v_t = NULL;
5866
lapack_complex_float* t_t = NULL;
5967
lapack_complex_float* a_t = NULL;
6068
lapack_complex_float* b_t = NULL;
6169
/* Check leading dimension(s) */
62-
if( lda < m ) {
70+
if( lda < ncolsA ) {
6371
info = -14;
6472
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
6573
return info;
@@ -69,7 +77,7 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
6977
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
7078
return info;
7179
}
72-
if( ldt < nb ) {
80+
if( ldt < k ) {
7381
info = -12;
7482
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
7583
return info;
@@ -87,13 +95,13 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
8795
goto exit_level_0;
8896
}
8997
t_t = (lapack_complex_float*)
90-
LAPACKE_malloc( sizeof(lapack_complex_float) * ldt_t * MAX(1,nb) );
98+
LAPACKE_malloc( sizeof(lapack_complex_float) * ldt_t * MAX(1,k) );
9199
if( t_t == NULL ) {
92100
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
93101
goto exit_level_1;
94102
}
95103
a_t = (lapack_complex_float*)
96-
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) );
104+
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,ncolsA) );
97105
if( a_t == NULL ) {
98106
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
99107
goto exit_level_2;
@@ -105,18 +113,18 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
105113
goto exit_level_3;
106114
}
107115
/* Transpose input matrices */
108-
LAPACKE_cge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
109-
LAPACKE_cge_trans( matrix_layout, ldt, nb, 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 );
116+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
117+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
118+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
119+
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
112120
/* Call LAPACK function and adjust info */
113121
LAPACK_ctpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
114122
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
115123
if( info < 0 ) {
116124
info = info - 1;
117125
}
118126
/* Transpose output matrices */
119-
LAPACKE_cge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
127+
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
120128
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
121129
/* Release memory and exit */
122130
LAPACKE_free( b_t );

‎LAPACKE/src/lapacke_dtpmqrt_work.c

+20-12
Original file line numberDiff line numberDiff line change
@@ -48,16 +48,24 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
4848
info = info - 1;
4949
}
5050
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
51-
lapack_int lda_t = MAX(1,k);
51+
lapack_int nrowsA, ncolsA, nrowsV;
52+
if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
53+
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
54+
else {
55+
info = -2;
56+
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
57+
return info;
58+
}
59+
lapack_int lda_t = MAX(1,nrowsA);
5260
lapack_int ldb_t = MAX(1,m);
53-
lapack_int ldt_t = MAX(1,ldt);
54-
lapack_int ldv_t = MAX(1,ldv);
61+
lapack_int ldt_t = MAX(1,nb);
62+
lapack_int ldv_t = MAX(1,nrowsV);
5563
double* v_t = NULL;
5664
double* t_t = NULL;
5765
double* a_t = NULL;
5866
double* b_t = NULL;
5967
/* Check leading dimension(s) */
60-
if( lda < m ) {
68+
if( lda < ncolsA ) {
6169
info = -14;
6270
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
6371
return info;
@@ -67,7 +75,7 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
6775
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
6876
return info;
6977
}
70-
if( ldt < nb ) {
78+
if( ldt < k ) {
7179
info = -12;
7280
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
7381
return info;
@@ -83,12 +91,12 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
8391
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
8492
goto exit_level_0;
8593
}
86-
t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,nb) );
94+
t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,k) );
8795
if( t_t == NULL ) {
8896
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
8997
goto exit_level_1;
9098
}
91-
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
99+
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,ncolsA) );
92100
if( a_t == NULL ) {
93101
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
94102
goto exit_level_2;
@@ -99,18 +107,18 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
99107
goto exit_level_3;
100108
}
101109
/* Transpose input matrices */
102-
LAPACKE_dge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
103-
LAPACKE_dge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
104-
LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
105-
LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
110+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
111+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
112+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
113+
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
106114
/* Call LAPACK function and adjust info */
107115
LAPACK_dtpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
108116
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
109117
if( info < 0 ) {
110118
info = info - 1;
111119
}
112120
/* Transpose output matrices */
113-
LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
121+
LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
114122
LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
115123
/* Release memory and exit */
116124
LAPACKE_free( b_t );

‎LAPACKE/src/lapacke_stpmqrt_work.c

+20-12
Original file line numberDiff line numberDiff line change
@@ -48,16 +48,24 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
4848
info = info - 1;
4949
}
5050
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
51-
lapack_int lda_t = MAX(1,k);
51+
lapack_int nrowsA, ncolsA, nrowsV;
52+
if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
53+
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
54+
else {
55+
info = -2;
56+
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
57+
return info;
58+
}
59+
lapack_int lda_t = MAX(1,nrowsA);
5260
lapack_int ldb_t = MAX(1,m);
53-
lapack_int ldt_t = MAX(1,ldt);
54-
lapack_int ldv_t = MAX(1,ldv);
61+
lapack_int ldt_t = MAX(1,nb);
62+
lapack_int ldv_t = MAX(1,nrowsV);
5563
float* v_t = NULL;
5664
float* t_t = NULL;
5765
float* a_t = NULL;
5866
float* b_t = NULL;
5967
/* Check leading dimension(s) */
60-
if( lda < m ) {
68+
if( lda < ncolsA ) {
6169
info = -14;
6270
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
6371
return info;
@@ -67,7 +75,7 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
6775
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
6876
return info;
6977
}
70-
if( ldt < nb ) {
78+
if( ldt < k ) {
7179
info = -12;
7280
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
7381
return info;
@@ -83,12 +91,12 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
8391
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
8492
goto exit_level_0;
8593
}
86-
t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,nb) );
94+
t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,k) );
8795
if( t_t == NULL ) {
8896
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
8997
goto exit_level_1;
9098
}
91-
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
99+
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,ncolsA) );
92100
if( a_t == NULL ) {
93101
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
94102
goto exit_level_2;
@@ -99,18 +107,18 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
99107
goto exit_level_3;
100108
}
101109
/* Transpose input matrices */
102-
LAPACKE_sge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
103-
LAPACKE_sge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
104-
LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
105-
LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
110+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
111+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
112+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
113+
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
106114
/* Call LAPACK function and adjust info */
107115
LAPACK_stpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
108116
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
109117
if( info < 0 ) {
110118
info = info - 1;
111119
}
112120
/* Transpose output matrices */
113-
LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
121+
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
114122
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
115123
/* Release memory and exit */
116124
LAPACKE_free( b_t );

‎LAPACKE/src/lapacke_ztpmqrt_work.c

+20-12
Original file line numberDiff line numberDiff line change
@@ -50,16 +50,24 @@ lapack_int LAPACKE_ztpmqrt_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 ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
55+
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
56+
else {
57+
info = -2;
58+
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
59+
return info;
60+
}
61+
lapack_int lda_t = MAX(1,nrowsA);
5462
lapack_int ldb_t = MAX(1,m);
55-
lapack_int ldt_t = MAX(1,ldt);
56-
lapack_int ldv_t = MAX(1,ldv);
63+
lapack_int ldt_t = MAX(1,nb);
64+
lapack_int ldv_t = MAX(1,nrowsV);
5765
lapack_complex_double* v_t = NULL;
5866
lapack_complex_double* t_t = NULL;
5967
lapack_complex_double* a_t = NULL;
6068
lapack_complex_double* b_t = NULL;
6169
/* Check leading dimension(s) */
62-
if( lda < m ) {
70+
if( lda < ncolsA ) {
6371
info = -14;
6472
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
6573
return info;
@@ -69,7 +77,7 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
6977
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
7078
return info;
7179
}
72-
if( ldt < nb ) {
80+
if( ldt < k ) {
7381
info = -12;
7482
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
7583
return info;
@@ -87,13 +95,13 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
8795
goto exit_level_0;
8896
}
8997
t_t = (lapack_complex_double*)
90-
LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,nb) );
98+
LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,k) );
9199
if( t_t == NULL ) {
92100
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
93101
goto exit_level_1;
94102
}
95103
a_t = (lapack_complex_double*)
96-
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,m) );
104+
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,ncolsA) );
97105
if( a_t == NULL ) {
98106
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
99107
goto exit_level_2;
@@ -105,18 +113,18 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
105113
goto exit_level_3;
106114
}
107115
/* Transpose input matrices */
108-
LAPACKE_zge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
109-
LAPACKE_zge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
110-
LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
111-
LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
116+
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
117+
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
118+
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
119+
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
112120
/* Call LAPACK function and adjust info */
113121
LAPACK_ztpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
114122
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
115123
if( info < 0 ) {
116124
info = info - 1;
117125
}
118126
/* Transpose output matrices */
119-
LAPACKE_zge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
127+
LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
120128
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
121129
/* Release memory and exit */
122130
LAPACKE_free( b_t );

0 commit comments

Comments
 (0)