Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
* except lapacke_lsame.c because of some incompatibility
  • Loading branch information
uecker committed Jul 7, 2024
1 parent 1416294 commit 371c64b
Show file tree
Hide file tree
Showing 42 changed files with 5,886 additions and 8,312 deletions.
12,208 changes: 4,333 additions & 7,875 deletions src/lapacke/lapacke.h

Large diffs are not rendered by default.

9 changes: 4 additions & 5 deletions src/lapacke/lapacke_cge_nancheck.c
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
/*****************************************************************************
Copyright (c) 2010, Intel Corp.
Copyright (c) 2014, Intel Corp.
All rights reserved.
Redistribution and use in source and binary forms, with or without
Expand Down Expand Up @@ -28,13 +28,12 @@
******************************************************************************
* Contents: Native C interface to LAPACK utility function
* Author: Intel Corporation
* Created in February, 2010
*****************************************************************************/
#include "lapacke_utils.h"

/* Check a matrix for NaN entries. */

lapack_logical LAPACKE_cge_nancheck( int matrix_order, lapack_int m,
lapack_logical API_SUFFIX(LAPACKE_cge_nancheck)( int matrix_layout, lapack_int m,
lapack_int n,
const lapack_complex_float *a,
lapack_int lda )
Expand All @@ -43,14 +42,14 @@ lapack_logical LAPACKE_cge_nancheck( int matrix_order, lapack_int m,

if( a == NULL ) return (lapack_logical) 0;

if( matrix_order == LAPACK_COL_MAJOR ) {
if( matrix_layout == LAPACK_COL_MAJOR ) {
for( j = 0; j < n; j++ ) {
for( i = 0; i < MIN( m, lda ); i++ ) {
if( LAPACK_CISNAN( a[i+(size_t)j*lda] ) )
return (lapack_logical) 1;
}
}
} else if ( matrix_order == LAPACK_ROW_MAJOR ) {
} else if ( matrix_layout == LAPACK_ROW_MAJOR ) {
for( i = 0; i < m; i++ ) {
for( j = 0; j < MIN( n, lda ); j++ ) {
if( LAPACK_CISNAN( a[(size_t)i*lda+j] ) )
Expand Down
9 changes: 4 additions & 5 deletions src/lapacke/lapacke_cge_trans.c
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
/*****************************************************************************
Copyright (c) 2010, Intel Corp.
Copyright (c) 2014, Intel Corp.
All rights reserved.
Redistribution and use in source and binary forms, with or without
Expand Down Expand Up @@ -28,7 +28,6 @@
******************************************************************************
* Contents: Native C interface to LAPACK utility function
* Author: Intel Corporation
* Created in February, 2010
*****************************************************************************/

#include "lapacke_utils.h"
Expand All @@ -37,18 +36,18 @@
* layout or vice versa.
*/

void LAPACKE_cge_trans( int matrix_order, lapack_int m, lapack_int n,
void API_SUFFIX(LAPACKE_cge_trans)( int matrix_layout, lapack_int m, lapack_int n,
const lapack_complex_float* in, lapack_int ldin,
lapack_complex_float* out, lapack_int ldout )
{
lapack_int i, j, x, y;

if( in == NULL || out == NULL ) return;

if( matrix_order == LAPACK_COL_MAJOR ) {
if( matrix_layout == LAPACK_COL_MAJOR ) {
x = n;
y = m;
} else if ( matrix_order == LAPACK_ROW_MAJOR ) {
} else if ( matrix_layout == LAPACK_ROW_MAJOR ) {
x = m;
y = n;
} else {
Expand Down
104 changes: 104 additions & 0 deletions src/lapacke/lapacke_cgees.c
Original file line number Diff line number Diff line change
@@ -0,0 +1,104 @@
/*****************************************************************************
Copyright (c) 2014, Intel Corp.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
* Neither the name of Intel Corporation nor the names of its contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
THE POSSIBILITY OF SUCH DAMAGE.
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cgees
* Author: Intel Corporation
*****************************************************************************/

#include "lapacke_utils.h"

lapack_int API_SUFFIX(LAPACKE_cgees)( int matrix_layout, char jobvs, char sort,
LAPACK_C_SELECT1 select, lapack_int n,
lapack_complex_float* a, lapack_int lda,
lapack_int* sdim, lapack_complex_float* w,
lapack_complex_float* vs, lapack_int ldvs )
{
lapack_int info = 0;
lapack_int lwork = -1;
lapack_logical* bwork = NULL;
float* rwork = NULL;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */
if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, n, n, a, lda ) ) {
return -6;
}
}
#endif
/* Allocate memory for working array(s) */
if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) {
bwork = (lapack_logical*)
LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
if( bwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_0;
}
}
rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,n) );
if( rwork == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_1;
}
/* Query optimal working array(s) size */
info = API_SUFFIX(LAPACKE_cgees_work)( matrix_layout, jobvs, sort, select, n, a, lda,
sdim, w, vs, ldvs, &work_query, lwork, rwork,
bwork );
if( info != 0 ) {
goto exit_level_2;
}
lwork = LAPACK_C2INT( work_query );
/* Allocate memory for work arrays */
work = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
if( work == NULL ) {
info = LAPACK_WORK_MEMORY_ERROR;
goto exit_level_2;
}
/* Call middle-level interface */
info = API_SUFFIX(LAPACKE_cgees_work)( matrix_layout, jobvs, sort, select, n, a, lda,
sdim, w, vs, ldvs, work, lwork, rwork, bwork );
/* Release memory and exit */
LAPACKE_free( work );
exit_level_2:
LAPACKE_free( rwork );
exit_level_1:
if( API_SUFFIX(LAPACKE_lsame)( sort, 's' ) ) {
LAPACKE_free( bwork );
}
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees", info );
}
return info;
}
117 changes: 117 additions & 0 deletions src/lapacke/lapacke_cgees_work.c
Original file line number Diff line number Diff line change
@@ -0,0 +1,117 @@
/*****************************************************************************
Copyright (c) 2014, Intel Corp.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice,
this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
* Neither the name of Intel Corporation nor the names of its contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF
THE POSSIBILITY OF SUCH DAMAGE.
*****************************************************************************
* Contents: Native middle-level C interface to LAPACK function cgees
* Author: Intel Corporation
*****************************************************************************/

#include "lapacke_utils.h"

lapack_int API_SUFFIX(LAPACKE_cgees_work)( int matrix_layout, char jobvs, char sort,
LAPACK_C_SELECT1 select, lapack_int n,
lapack_complex_float* a, lapack_int lda,
lapack_int* sdim, lapack_complex_float* w,
lapack_complex_float* vs, lapack_int ldvs,
lapack_complex_float* work, lapack_int lwork,
float* rwork, lapack_logical* bwork )
{
lapack_int info = 0;
if( matrix_layout == LAPACK_COL_MAJOR ) {
/* Call LAPACK function and adjust info */
LAPACK_cgees( &jobvs, &sort, select, &n, a, &lda, sdim, w, vs, &ldvs,
work, &lwork, rwork, bwork, &info );
if( info < 0 ) {
info = info - 1;
}
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
lapack_int lda_t = MAX(1,n);
lapack_int ldvs_t = MAX(1,n);
lapack_complex_float* a_t = NULL;
lapack_complex_float* vs_t = NULL;
/* Check leading dimension(s) */
if( lda < n ) {
info = -7;
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info );
return info;
}
if( ldvs < n ) {
info = -11;
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info );
return info;
}
/* Query optimal working array(s) size if requested */
if( lwork == -1 ) {
LAPACK_cgees( &jobvs, &sort, select, &n, a, &lda_t, sdim, w, vs,
&ldvs_t, work, &lwork, rwork, bwork, &info );
return (info < 0) ? (info - 1) : info;
}
/* Allocate memory for temporary array(s) */
a_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) );
if( a_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_0;
}
if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) {
vs_t = (lapack_complex_float*)
LAPACKE_malloc( sizeof(lapack_complex_float) *
ldvs_t * MAX(1,n) );
if( vs_t == NULL ) {
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
goto exit_level_1;
}
}
/* Transpose input matrices */
API_SUFFIX(LAPACKE_cge_trans)( matrix_layout, n, n, a, lda, a_t, lda_t );
/* Call LAPACK function and adjust info */
LAPACK_cgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, w, vs_t,
&ldvs_t, work, &lwork, rwork, bwork, &info );
if( info < 0 ) {
info = info - 1;
}
/* Transpose output matrices */
API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) {
API_SUFFIX(LAPACKE_cge_trans)( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs );
}
/* Release memory and exit */
if( API_SUFFIX(LAPACKE_lsame)( jobvs, 'v' ) ) {
LAPACKE_free( vs_t );
}
exit_level_1:
LAPACKE_free( a_t );
exit_level_0:
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info );
}
} else {
info = -1;
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgees_work", info );
}
return info;
}
29 changes: 15 additions & 14 deletions src/lapacke/lapacke_cgesdd.c
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
/*****************************************************************************
Copyright (c) 2011, Intel Corp.
Copyright (c) 2014, Intel Corp.
All rights reserved.
Redistribution and use in source and binary forms, with or without
Expand Down Expand Up @@ -28,12 +28,11 @@
*****************************************************************************
* Contents: Native high-level C interface to LAPACK function cgesdd
* Author: Intel Corporation
* Generated November, 2011
*****************************************************************************/

#include "lapacke_utils.h"

lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
lapack_int API_SUFFIX(LAPACKE_cgesdd)( int matrix_layout, char jobz, lapack_int m,
lapack_int n, lapack_complex_float* a,
lapack_int lda, float* s, lapack_complex_float* u,
lapack_int ldu, lapack_complex_float* vt,
Expand All @@ -47,21 +46,23 @@ lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
float* rwork = NULL;
lapack_complex_float* work = NULL;
lapack_complex_float work_query;
if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
LAPACKE_xerbla( "LAPACKE_cgesdd", -1 );
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd", -1 );
return -1;
}
#ifndef LAPACK_DISABLE_NAN_CHECK
/* Optionally check input matrices for NaNs */
if( LAPACKE_cge_nancheck( matrix_order, m, n, a, lda ) ) {
return -5;
if( LAPACKE_get_nancheck() ) {
/* Optionally check input matrices for NaNs */
if( API_SUFFIX(LAPACKE_cge_nancheck)( matrix_layout, m, n, a, lda ) ) {
return -5;
}
}
#endif
/* Additional scalars initializations for work arrays */
if( LAPACKE_lsame( jobz, 'n' ) ) {
lrwork = MAX(1,5*MIN(m,n));
if( API_SUFFIX(LAPACKE_lsame)( jobz, 'n' ) ) {
lrwork = MAX(1,7*MIN(m,n));
} else {
lrwork = (size_t)5*MAX(1,MIN(m,n))*MAX(1,MIN(m,n))+7*MIN(m,n);
lrwork = (size_t)MAX(1,MIN(m,n)*MAX(5*MIN(m,n)+7,2*MAX(m,n)+2*MIN(m,n)+1));
}
/* Allocate memory for working array(s) */
iwork = (lapack_int*)
Expand All @@ -76,7 +77,7 @@ lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
goto exit_level_1;
}
/* Query optimal working array(s) size */
info = LAPACKE_cgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
info = API_SUFFIX(LAPACKE_cgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt,
ldvt, &work_query, lwork, rwork, iwork );
if( info != 0 ) {
goto exit_level_2;
Expand All @@ -90,7 +91,7 @@ lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
goto exit_level_2;
}
/* Call middle-level interface */
info = LAPACKE_cgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
info = API_SUFFIX(LAPACKE_cgesdd_work)( matrix_layout, jobz, m, n, a, lda, s, u, ldu, vt,
ldvt, work, lwork, rwork, iwork );
/* Release memory and exit */
LAPACKE_free( work );
Expand All @@ -100,7 +101,7 @@ lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
LAPACKE_free( iwork );
exit_level_0:
if( info == LAPACK_WORK_MEMORY_ERROR ) {
LAPACKE_xerbla( "LAPACKE_cgesdd", info );
API_SUFFIX(LAPACKE_xerbla)( "LAPACKE_cgesdd", info );
}
return info;
}
Loading

0 comments on commit 371c64b

Please sign in to comment.