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

Refs #615. Import bug fixes for LAPACKE dormlq.

This commit is contained in:
Zhang Xianyi 2015-10-07 02:31:51 +08:00
parent 11ac4665c8
commit 90aa8e24b9
4 changed files with 36 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
lapack-netlib/lapacke/src/lapacke_cunmlq_work.c
View File

@ -1,5 +1,5 @@
/***************************************************************************** /*****************************************************************************
Copyright (c) 2011, Intel Corp. Copyright (c) 2014, Intel Corp.
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
@ -33,7 +33,7 @@
#include "lapacke_utils.h" #include "lapacke_utils.h"
lapack_int LAPACKE_cunmlq_work( int matrix_order, char side, char trans, lapack_int LAPACKE_cunmlq_work( int matrix_layout, char side, char trans,
lapack_int m, lapack_int n, lapack_int k, lapack_int m, lapack_int n, lapack_int k,
const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* a, lapack_int lda,
const lapack_complex_float* tau, const lapack_complex_float* tau,
@ -41,20 +41,22 @@ lapack_int LAPACKE_cunmlq_work( int matrix_order, char side, char trans,
lapack_complex_float* work, lapack_int lwork ) lapack_complex_float* work, lapack_int lwork )
{ {
lapack_int info = 0; lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) { lapack_int r;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_cunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
&lwork, &info ); &lwork, &info );
if( info < 0 ) { if( info < 0 ) {
info = info - 1; info = info - 1;
} }
} else if( matrix_order == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int lda_t = MAX(1,k); lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m); lapack_int ldc_t = MAX(1,m);
lapack_complex_float* a_t = NULL; lapack_complex_float* a_t = NULL;
lapack_complex_float* c_t = NULL; lapack_complex_float* c_t = NULL;
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < m ) { if( lda < r ) {
info = -8; info = -8;
LAPACKE_xerbla( "LAPACKE_cunmlq_work", info ); LAPACKE_xerbla( "LAPACKE_cunmlq_work", info );
return info; return info;
@ -84,8 +86,8 @@ lapack_int LAPACKE_cunmlq_work( int matrix_order, char side, char trans,
goto exit_level_1; goto exit_level_1;
} }
/* Transpose input matrices */ /* Transpose input matrices */
LAPACKE_cge_trans( matrix_order, k, m, a, lda, a_t, lda_t ); LAPACKE_cge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_cge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t ); LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_cunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, LAPACK_cunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
work, &lwork, &info ); work, &lwork, &info );

16
lapack-netlib/lapacke/src/lapacke_dormlq_work.c
View File

@ -1,5 +1,5 @@
/***************************************************************************** /*****************************************************************************
Copyright (c) 2011, Intel Corp. Copyright (c) 2014, Intel Corp.
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
@ -33,27 +33,29 @@
#include "lapacke_utils.h" #include "lapacke_utils.h"
lapack_int LAPACKE_dormlq_work( int matrix_order, char side, char trans, lapack_int LAPACKE_dormlq_work( int matrix_layout, char side, char trans,
lapack_int m, lapack_int n, lapack_int k, lapack_int m, lapack_int n, lapack_int k,
const double* a, lapack_int lda, const double* a, lapack_int lda,
const double* tau, double* c, lapack_int ldc, const double* tau, double* c, lapack_int ldc,
double* work, lapack_int lwork ) double* work, lapack_int lwork )
{ {
lapack_int info = 0; lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t; lapack_int lda_t, ldc_t;
double *a_t = NULL, *c_t = NULL; double *a_t = NULL, *c_t = NULL;
if( matrix_order == LAPACK_COL_MAJOR ) { if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_dormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_dormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
&lwork, &info ); &lwork, &info );
if( info < 0 ) { if( info < 0 ) {
info = info - 1; info = info - 1;
} }
} else if( matrix_order == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k); lda_t = MAX(1,k);
ldc_t = MAX(1,m); ldc_t = MAX(1,m);
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < m ) { if( lda < r ) {
info = -8; info = -8;
LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); LAPACKE_xerbla( "LAPACKE_dormlq_work", info );
return info; return info;
@ -81,8 +83,8 @@ lapack_int LAPACKE_dormlq_work( int matrix_order, char side, char trans,
goto exit_level_1; goto exit_level_1;
} }
/* Transpose input matrices */ /* Transpose input matrices */
LAPACKE_dge_trans( matrix_order, k, m, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t ); LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, LAPACK_dormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
work, &lwork, &info ); work, &lwork, &info );

16
lapack-netlib/lapacke/src/lapacke_sormlq_work.c
View File

@ -1,5 +1,5 @@
/***************************************************************************** /*****************************************************************************
Copyright (c) 2011, Intel Corp. Copyright (c) 2014, Intel Corp.
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
@ -33,27 +33,29 @@
#include "lapacke_utils.h" #include "lapacke_utils.h"
lapack_int LAPACKE_sormlq_work( int matrix_order, char side, char trans, lapack_int LAPACKE_sormlq_work( int matrix_layout, char side, char trans,
lapack_int m, lapack_int n, lapack_int k, lapack_int m, lapack_int n, lapack_int k,
const float* a, lapack_int lda, const float* a, lapack_int lda,
const float* tau, float* c, lapack_int ldc, const float* tau, float* c, lapack_int ldc,
float* work, lapack_int lwork ) float* work, lapack_int lwork )
{ {
lapack_int info = 0; lapack_int info = 0;
lapack_int r;
lapack_int lda_t, ldc_t; lapack_int lda_t, ldc_t;
float *a_t = NULL, *c_t = NULL; float *a_t = NULL, *c_t = NULL;
if( matrix_order == LAPACK_COL_MAJOR ) { if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_sormlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
&lwork, &info ); &lwork, &info );
if( info < 0 ) { if( info < 0 ) {
info = info - 1; info = info - 1;
} }
} else if( matrix_order == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_t = MAX(1,k); lda_t = MAX(1,k);
ldc_t = MAX(1,m); ldc_t = MAX(1,m);
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < m ) { if( lda < r ) {
info = -8; info = -8;
LAPACKE_xerbla( "LAPACKE_sormlq_work", info ); LAPACKE_xerbla( "LAPACKE_sormlq_work", info );
return info; return info;
@ -81,8 +83,8 @@ lapack_int LAPACKE_sormlq_work( int matrix_order, char side, char trans,
goto exit_level_1; goto exit_level_1;
} }
/* Transpose input matrices */ /* Transpose input matrices */
LAPACKE_sge_trans( matrix_order, k, m, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t ); LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, LAPACK_sormlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
work, &lwork, &info ); work, &lwork, &info );

16
lapack-netlib/lapacke/src/lapacke_zunmlq_work.c
View File

@ -1,5 +1,5 @@
/***************************************************************************** /*****************************************************************************
Copyright (c) 2011, Intel Corp. Copyright (c) 2014, Intel Corp.
All rights reserved. All rights reserved.
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
@ -33,7 +33,7 @@
#include "lapacke_utils.h" #include "lapacke_utils.h"
lapack_int LAPACKE_zunmlq_work( int matrix_order, char side, char trans, lapack_int LAPACKE_zunmlq_work( int matrix_layout, char side, char trans,
lapack_int m, lapack_int n, lapack_int k, lapack_int m, lapack_int n, lapack_int k,
const lapack_complex_double* a, lapack_int lda, const lapack_complex_double* a, lapack_int lda,
const lapack_complex_double* tau, const lapack_complex_double* tau,
@ -41,20 +41,22 @@ lapack_int LAPACKE_zunmlq_work( int matrix_order, char side, char trans,
lapack_complex_double* work, lapack_int lwork ) lapack_complex_double* work, lapack_int lwork )
{ {
lapack_int info = 0; lapack_int info = 0;
if( matrix_order == LAPACK_COL_MAJOR ) { lapack_int r;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work, LAPACK_zunmlq( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
&lwork, &info ); &lwork, &info );
if( info < 0 ) { if( info < 0 ) {
info = info - 1; info = info - 1;
} }
} else if( matrix_order == LAPACK_ROW_MAJOR ) { } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lapack_int lda_t = MAX(1,k); lapack_int lda_t = MAX(1,k);
lapack_int ldc_t = MAX(1,m); lapack_int ldc_t = MAX(1,m);
lapack_complex_double* a_t = NULL; lapack_complex_double* a_t = NULL;
lapack_complex_double* c_t = NULL; lapack_complex_double* c_t = NULL;
/* Check leading dimension(s) */ /* Check leading dimension(s) */
if( lda < m ) { if( lda < r ) {
info = -8; info = -8;
LAPACKE_xerbla( "LAPACKE_zunmlq_work", info ); LAPACKE_xerbla( "LAPACKE_zunmlq_work", info );
return info; return info;
@ -84,8 +86,8 @@ lapack_int LAPACKE_zunmlq_work( int matrix_order, char side, char trans,
goto exit_level_1; goto exit_level_1;
} }
/* Transpose input matrices */ /* Transpose input matrices */
LAPACKE_zge_trans( matrix_order, k, m, a, lda, a_t, lda_t ); LAPACKE_zge_trans( matrix_layout, k, m, a, lda, a_t, lda_t );
LAPACKE_zge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t ); LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
/* Call LAPACK function and adjust info */ /* Call LAPACK function and adjust info */
LAPACK_zunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t, LAPACK_zunmlq( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
work, &lwork, &info ); work, &lwork, &info );