Browse Source

LAPACKE: fix wrong number of columns in ?ormlq

Copied from lapack https://github.com/Reference-LAPACK/lapack/pull/127  by vladimir-ch (with earlier changes from echeresh's  
PR 115 "lapacke_*ormlq_work: move declarations under if" there as they touched some of the same files)
tags/v0.2.20^2
Martin Kroeker GitHub 9 years ago
parent
commit
3f7720ec4b
6 changed files with 26 additions and 36 deletions
  1. +4
    -5
      lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c
  2. +2
    -1
      lapack-netlib/LAPACKE/src/lapacke_dormlq.c
  3. +7
    -12
      lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c
  4. +2
    -1
      lapack-netlib/LAPACKE/src/lapacke_sormlq.c
  5. +7
    -12
      lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c
  6. +4
    -5
      lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c

+ 4
- 5
lapack-netlib/LAPACKE/src/lapacke_cunmlq_work.c View File

@@ -42,9 +42,6 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
{
lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t;
lapack_complex_float* a_t = NULL;
lapack_complex_float* c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@@ -54,8 +51,10 @@ lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k);
ldc_t = MAX(1,m);
lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m);
lapack_complex_float* a_t = NULL;
lapack_complex_float* c_t = NULL;
/* Check leading dimension(s) */
if( lda < r ) {
info = -8;


+ 2
- 1
lapack-netlib/LAPACKE/src/lapacke_dormlq.c View File

@@ -48,7 +48,8 @@ lapack_int LAPACKE_dormlq( int matrix_layout, char side, char trans,
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_dge_nancheck( matrix_layout, k, m, a, lda ) ) {
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
if( LAPACKE_dge_nancheck( matrix_layout, k, r, a, lda ) ) {
return -7;
}
if( LAPACKE_dge_nancheck( matrix_layout, m, n, c, ldc ) ) {


+ 7
- 12
lapack-netlib/LAPACKE/src/lapacke_dormlq_work.c View File

@@ -40,9 +40,6 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
double* work, lapack_int lwork )
{
lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t;
double *a_t = NULL, *c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_dormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@@ -51,9 +48,11 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k);
ldc_t = MAX(1,m);
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m);
double *a_t = NULL;
double *c_t = NULL;
/* Check leading dimension(s) */
if( lda < r ) {
info = -8;
@@ -72,11 +71,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( side, 'l' ) ) {
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) );
} else {
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
}
a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,r) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
@@ -87,7 +82,7 @@ lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_dge_trans( matrix_layout, k, r, a, lda, a_t, lda_t );
LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */
LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,


+ 2
- 1
lapack-netlib/LAPACKE/src/lapacke_sormlq.c View File

@@ -48,7 +48,8 @@ lapack_int LAPACKE_sormlq( int matrix_layout, char side, char trans,
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_sge_nancheck( matrix_layout, k, m, a, lda ) ) {
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
if( LAPACKE_sge_nancheck( matrix_layout, k, r, a, lda ) ) {
return -7;
}
if( LAPACKE_sge_nancheck( matrix_layout, m, n, c, ldc ) ) {


+ 7
- 12
lapack-netlib/LAPACKE/src/lapacke_sormlq_work.c View File

@@ -40,9 +40,6 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
float* work, lapack_int lwork )
{
lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t;
float *a_t = NULL, *c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@@ -51,9 +48,11 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k);
ldc_t = MAX(1,m);
lapack_int r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m);
float *a_t = NULL;
float *c_t = NULL;
/* Check leading dimension(s) */
if( lda < r ) {
info = -8;
@@ -72,11 +71,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
if( LAPACKE_lsame( side, 'l' ) ) {
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) );
} else {
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) );
}
a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,r) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
@@ -87,7 +82,7 @@ lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
goto exit_level_1;
}
/* Transpose input matrices */
LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_layout, k, r, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */
LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,


+ 4
- 5
lapack-netlib/LAPACKE/src/lapacke_zunmlq_work.c View File

@@ -42,9 +42,6 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
{
lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t;
lapack_complex_double* a_t = NULL;
lapack_complex_double* c_t = NULL;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
@@ -54,8 +51,10 @@ lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k);
ldc_t = MAX(1,m);
lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m);
lapack_complex_double* a_t = NULL;
lapack_complex_double* c_t = NULL;
/* Check leading dimension(s) */
if( lda < r ) {
info = -8;


Loading…
Cancel
Save