floraachy
/
OpenBLAS
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix errors in LAPACKE ?tpmqrt for row major matrices (Reference-LAPACK PR540)

This commit is contained in:
Martin Kroeker 2022-11-17 18:06:17 +01:00 committed by GitHub
parent 76ae221330
commit 4f82699ec9
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
4 changed files with 80 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
lapack-netlib/LAPACKE/src/lapacke_ctpmqrt_work.c
View File

@ -50,16 +50,24 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,k);
lapack_int nrowsA, ncolsA, nrowsV;
if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
else {
info = -2;
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
return info;
}
lapack_int lda_t = MAX(1,nrowsA);
lapack_int ldb_t = MAX(1,m);
lapack_int ldt_t = MAX(1,ldt);
lapack_int ldv_t = MAX(1,ldv);
lapack_int ldt_t = MAX(1,nb);
lapack_int ldv_t = MAX(1,nrowsV);
lapack_complex_float* v_t = NULL;
lapack_complex_float* t_t = NULL;
lapack_complex_float* a_t = NULL;
lapack_complex_float* b_t = NULL;
/* Check leading dimension(s) */
if( lda < m ) {
if( lda < ncolsA ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
return info;
@ -69,7 +77,7 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
return info;
}
if( ldt < nb ) {
if( ldt < k ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_ctpmqrt_work", info );
return info;
@ -87,13 +95,13 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
goto exit_level_0;
}
t_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * ldt_t * MAX(1,nb) );
LAPACKE_malloc( sizeof(lapack_complex_float) * ldt_t * MAX(1,k) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
a_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) );
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,ncolsA) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
@ -105,10 +113,10 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
goto exit_level_3;
}
/* Transpose input matrices */
LAPACKE_cge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
LAPACKE_cge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_cge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_ctpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
@ -116,7 +124,7 @@ lapack_int LAPACKE_ctpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( b_t );

32
lapack-netlib/LAPACKE/src/lapacke_dtpmqrt_work.c
View File

@ -48,16 +48,24 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,k);
lapack_int nrowsA, ncolsA, nrowsV;
if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
else {
info = -2;
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
return info;
}
lapack_int lda_t = MAX(1,nrowsA);
lapack_int ldb_t = MAX(1,m);
lapack_int ldt_t = MAX(1,ldt);
lapack_int ldv_t = MAX(1,ldv);
lapack_int ldt_t = MAX(1,nb);
lapack_int ldv_t = MAX(1,nrowsV);
double* v_t = NULL;
double* t_t = NULL;
double* a_t = NULL;
double* b_t = NULL;
/* Check leading dimension(s) */
if( lda < m ) {
if( lda < ncolsA ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
return info;
@ -67,7 +75,7 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
return info;
}
if( ldt < nb ) {
if( ldt < k ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_dtpmqrt_work", info );
return info;
@ -83,12 +91,12 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,nb) );
t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,k) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,ncolsA) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
@ -99,10 +107,10 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
goto exit_level_3;
}
/* Transpose input matrices */
LAPACKE_dge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
LAPACKE_dge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_dge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_dtpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
@ -110,7 +118,7 @@ lapack_int LAPACKE_dtpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
LAPACKE_dge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( b_t );

32
lapack-netlib/LAPACKE/src/lapacke_stpmqrt_work.c
View File

@ -48,16 +48,24 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,k);
lapack_int nrowsA, ncolsA, nrowsV;
if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
else {
info = -2;
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
return info;
}
lapack_int lda_t = MAX(1,nrowsA);
lapack_int ldb_t = MAX(1,m);
lapack_int ldt_t = MAX(1,ldt);
lapack_int ldv_t = MAX(1,ldv);
lapack_int ldt_t = MAX(1,nb);
lapack_int ldv_t = MAX(1,nrowsV);
float* v_t = NULL;
float* t_t = NULL;
float* a_t = NULL;
float* b_t = NULL;
/* Check leading dimension(s) */
if( lda < m ) {
if( lda < ncolsA ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
return info;
@ -67,7 +75,7 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
return info;
}
if( ldt < nb ) {
if( ldt < k ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_stpmqrt_work", info );
return info;
@ -83,12 +91,12 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,nb) );
t_t = (float*)LAPACKE_malloc( sizeof(float) * ldt_t * MAX(1,k) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,ncolsA) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
@ -99,10 +107,10 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
goto exit_level_3;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
LAPACKE_sge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_stpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
@ -110,7 +118,7 @@ lapack_int LAPACKE_stpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( b_t );

32
lapack-netlib/LAPACKE/src/lapacke_ztpmqrt_work.c
View File

@ -50,16 +50,24 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,k);
lapack_int nrowsA, ncolsA, nrowsV;
if ( side == LAPACKE_lsame(side, 'l') ) { nrowsA = k; ncolsA = n; nrowsV = m; }
else if ( side == LAPACKE_lsame(side, 'r') ) { nrowsA = m; ncolsA = k; nrowsV = n; }
else {
info = -2;
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
return info;
}
lapack_int lda_t = MAX(1,nrowsA);
lapack_int ldb_t = MAX(1,m);
lapack_int ldt_t = MAX(1,ldt);
lapack_int ldv_t = MAX(1,ldv);
lapack_int ldt_t = MAX(1,nb);
lapack_int ldv_t = MAX(1,nrowsV);
lapack_complex_double* v_t = NULL;
lapack_complex_double* t_t = NULL;
lapack_complex_double* a_t = NULL;
lapack_complex_double* b_t = NULL;
/* Check leading dimension(s) */
if( lda < m ) {
if( lda < ncolsA ) {
info = -14;
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
return info;
@ -69,7 +77,7 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
return info;
}
if( ldt < nb ) {
if( ldt < k ) {
info = -12;
LAPACKE_xerbla( "LAPACKE_ztpmqrt_work", info );
return info;
@ -87,13 +95,13 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
goto exit_level_0;
}
t_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,nb) );
LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,k) );
if( t_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
a_t = (lapack_complex_double*)
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,m) );
LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,ncolsA) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_2;
@ -105,10 +113,10 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
goto exit_level_3;
}
/* Transpose input matrices */
LAPACKE_zge_trans( matrix_layout, ldv, k, v, ldv, v_t, ldv_t );
LAPACKE_zge_trans( matrix_layout, ldt, nb, t, ldt, t_t, ldt_t );
LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_zge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nrowsV, k, v, ldv, v_t, ldv_t );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nb, k, t, ldt, t_t, ldt_t );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, nrowsA, ncolsA, a, lda, a_t, lda_t );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, b, ldb, b_t, ldb_t );
/* Call LAPACK function and adjust info */
LAPACK_ztpmqrt( &side, &trans, &m, &n, &k, &l, &nb, v_t, &ldv_t, t_t,
&ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &info );
@ -116,7 +124,7 @@ lapack_int LAPACKE_ztpmqrt_work( int matrix_layout, char side, char trans,
info = info - 1;
}
/* Transpose output matrices */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrowsA, ncolsA, a_t, lda_t, a, lda );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
/* Release memory and exit */
LAPACKE_free( b_t );