From 2a859d5fc4b87971091d8339bf281feb3741d4b8 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Wed, 24 Jun 2026 18:33:45 +0200 Subject: [PATCH] Fix row-major A dimension for SIDE=R (Reference-LAPACK PR 1287) --- .../LAPACKE/src/lapacke_ctprfb_work.c | 44 +++++++++++++------ .../LAPACKE/src/lapacke_dtprfb_work.c | 44 +++++++++++++------ .../LAPACKE/src/lapacke_stprfb_work.c | 44 +++++++++++++------ .../LAPACKE/src/lapacke_ztprfb_work.c | 44 +++++++++++++------ 4 files changed, 124 insertions(+), 52 deletions(-) diff --git a/lapack-netlib/LAPACKE/src/lapacke_ctprfb_work.c b/lapack-netlib/LAPACKE/src/lapacke_ctprfb_work.c index 8406c1a877..09da98f674 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ctprfb_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ctprfb_work.c @@ -50,16 +50,26 @@ lapack_int LAPACKE_ctprfb_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( LAPACKE_lsame(side, 'l') ) { + nrowsA = k; ncolsA = n; nrowsV = m; + } else if( LAPACKE_lsame(side, 'r') ) { + nrowsA = m; ncolsA = k; nrowsV = n; + } else { + info = -2; + LAPACKE_xerbla( "LAPACKE_ctprfb_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 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 = -15; LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); return info; @@ -74,10 +84,18 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans, LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); return info; } - if( ldv < k ) { - info = -11; - LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); - return info; + if( LAPACKE_lsame(storev, 'c') ) { + if( ldv < nrowsV ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + return info; + } + } else { + if( ldv < k ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_ctprfb_work", info ); + return info; + } } /* Allocate memory for temporary array(s) */ v_t = (lapack_complex_float*) @@ -93,7 +111,7 @@ lapack_int LAPACKE_ctprfb_work( int matrix_layout, char side, char trans, 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,17 +123,17 @@ lapack_int LAPACKE_ctprfb_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, k, 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, ldt, 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_ctprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* 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 ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c b/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c index e4be902045..ae5eac9af5 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_dtprfb_work.c @@ -49,16 +49,26 @@ lapack_int LAPACKE_dtprfb_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( LAPACKE_lsame(side, 'l') ) { + nrowsA = k; ncolsA = n; nrowsV = m; + } else if( LAPACKE_lsame(side, 'r') ) { + nrowsA = m; ncolsA = k; nrowsV = n; + } else { + info = -2; + LAPACKE_xerbla( "LAPACKE_dtprfb_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 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 = -15; LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); return info; @@ -73,10 +83,18 @@ lapack_int LAPACKE_dtprfb_work( int matrix_layout, char side, char trans, LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); return info; } - if( ldv < k ) { - info = -11; - LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); - return info; + if( LAPACKE_lsame(storev, 'c') ) { + if( ldv < nrowsV ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + return info; + } + } else { + if( ldv < k ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); + return info; + } } /* Allocate memory for temporary array(s) */ 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, 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; @@ -100,17 +118,17 @@ lapack_int LAPACKE_dtprfb_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, k, 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, ldt, 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_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* 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 ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c b/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c index 06f9faa7c1..61cdf17811 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_stprfb_work.c @@ -49,16 +49,26 @@ lapack_int LAPACKE_stprfb_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( LAPACKE_lsame(side, 'l') ) { + nrowsA = k; ncolsA = n; nrowsV = m; + } else if( LAPACKE_lsame(side, 'r') ) { + nrowsA = m; ncolsA = k; nrowsV = n; + } else { + info = -2; + LAPACKE_xerbla( "LAPACKE_stprfb_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 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 = -15; LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); return info; @@ -73,10 +83,18 @@ lapack_int LAPACKE_stprfb_work( int matrix_layout, char side, char trans, LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); return info; } - if( ldv < k ) { - info = -11; - LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); - return info; + if( LAPACKE_lsame(storev, 'c') ) { + if( ldv < nrowsV ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + return info; + } + } else { + if( ldv < k ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_stprfb_work", info ); + return info; + } } /* Allocate memory for temporary array(s) */ 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, 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; @@ -100,17 +118,17 @@ lapack_int LAPACKE_stprfb_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, k, 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, ldt, 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_stprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* 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 ); diff --git a/lapack-netlib/LAPACKE/src/lapacke_ztprfb_work.c b/lapack-netlib/LAPACKE/src/lapacke_ztprfb_work.c index 36944bbed2..942ae4826a 100644 --- a/lapack-netlib/LAPACKE/src/lapacke_ztprfb_work.c +++ b/lapack-netlib/LAPACKE/src/lapacke_ztprfb_work.c @@ -50,16 +50,26 @@ lapack_int LAPACKE_ztprfb_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( LAPACKE_lsame(side, 'l') ) { + nrowsA = k; ncolsA = n; nrowsV = m; + } else if( LAPACKE_lsame(side, 'r') ) { + nrowsA = m; ncolsA = k; nrowsV = n; + } else { + info = -2; + LAPACKE_xerbla( "LAPACKE_ztprfb_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 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 = -15; LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); return info; @@ -74,10 +84,18 @@ lapack_int LAPACKE_ztprfb_work( int matrix_layout, char side, char trans, LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); return info; } - if( ldv < k ) { - info = -11; - LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); - return info; + if( LAPACKE_lsame(storev, 'c') ) { + if( ldv < nrowsV ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + return info; + } + } else { + if( ldv < k ) { + info = -11; + LAPACKE_xerbla( "LAPACKE_ztprfb_work", info ); + return info; + } } /* Allocate memory for temporary array(s) */ v_t = (lapack_complex_double*) @@ -93,7 +111,7 @@ lapack_int LAPACKE_ztprfb_work( int matrix_layout, char side, char trans, 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,17 +123,17 @@ lapack_int LAPACKE_ztprfb_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, k, 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, ldt, 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_ztprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, work, &ldwork ); info = 0; /* LAPACK call is ok! */ /* 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 );