Skip to content

Commit 2e1e51f

Browse files
angschangsch
committed
LAPACKE interface of [cz]trsyl3
1 parent fcbb28d commit 2e1e51f

File tree

8 files changed

+347
-0
lines changed

8 files changed

+347
-0
lines changed

‎LAPACKE/include/lapack.h‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -21986,6 +21986,25 @@ void LAPACK_ztrsyl_base(
2198621986
#define LAPACK_ztrsyl(...) LAPACK_ztrsyl_base(__VA_ARGS__)
2198721987
#endif
2198821988

21989+
#define LAPACK_ctrsyl3_base LAPACK_GLOBAL(ctrsyl3,CTRSYL3)
21990+
void LAPACK_ctrsyl3_base(
21991+
char const* trana, char const* tranb,
21992+
lapack_int const* isgn, lapack_int const* m, lapack_int const* n,
21993+
lapack_complex_float const* A, lapack_int const* lda,
21994+
lapack_complex_float const* B, lapack_int const* ldb,
21995+
lapack_complex_float* C, lapack_int const* ldc, float* scale,
21996+
float* swork, lapack_int const *ldswork,
21997+
lapack_int* info
21998+
#ifdef LAPACK_FORTRAN_STRLEN_END
21999+
, size_t, size_t
22000+
#endif
22001+
);
22002+
#ifdef LAPACK_FORTRAN_STRLEN_END
22003+
#define LAPACK_ctrsyl3(...) LAPACK_ctrsyl3_base(__VA_ARGS__, 1, 1)
22004+
#else
22005+
#define LAPACK_ctrsyl3(...) LAPACK_ctrsyl3_base(__VA_ARGS__)
22006+
#endif
22007+
2198922008
#define LAPACK_dtrsyl3_base LAPACK_GLOBAL(dtrsyl3,DTRSYL3)
2199022009
void LAPACK_dtrsyl3_base(
2199122010
char const* trana, char const* tranb,
@@ -22026,6 +22045,25 @@ void LAPACK_strsyl3_base(
2202622045
#define LAPACK_strsyl3(...) LAPACK_strsyl3_base(__VA_ARGS__)
2202722046
#endif
2202822047

22048+
#define LAPACK_ztrsyl3_base LAPACK_GLOBAL(ztrsyl3,ZTRSYL3)
22049+
void LAPACK_ztrsyl3_base(
22050+
char const* trana, char const* tranb,
22051+
lapack_int const* isgn, lapack_int const* m, lapack_int const* n,
22052+
lapack_complex_double const* A, lapack_int const* lda,
22053+
lapack_complex_double const* B, lapack_int const* ldb,
22054+
lapack_complex_double* C, lapack_int const* ldc, double* scale,
22055+
double* swork, lapack_int const *ldswork,
22056+
lapack_int* info
22057+
#ifdef LAPACK_FORTRAN_STRLEN_END
22058+
, size_t, size_t
22059+
#endif
22060+
);
22061+
#ifdef LAPACK_FORTRAN_STRLEN_END
22062+
#define LAPACK_ztrsyl3(...) LAPACK_ztrsyl3_base(__VA_ARGS__, 1, 1)
22063+
#else
22064+
#define LAPACK_ztrsyl3(...) LAPACK_ztrsyl3_base(__VA_ARGS__)
22065+
#endif
22066+
2202922067
#define LAPACK_ctrtri_base LAPACK_GLOBAL(ctrtri,CTRTRI)
2203022068
void LAPACK_ctrtri_base(
2203122069
char const* uplo, char const* diag,

‎LAPACKE/include/lapacke.h‎

Lines changed: 13 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4487,6 +4487,12 @@ lapack_int LAPACKE_dtrsyl3( int matrix_layout, char trana, char tranb,
44874487
const double* a, lapack_int lda, const double* b,
44884488
lapack_int ldb, double* c, lapack_int ldc,
44894489
double* scale );
4490+
lapack_int LAPACKE_ztrsyl3( int matrix_layout, char trana, char tranb,
4491+
lapack_int isgn, lapack_int m, lapack_int n,
4492+
const lapack_complex_double* a, lapack_int lda,
4493+
const lapack_complex_double* b, lapack_int ldb,
4494+
lapack_complex_double* c, lapack_int ldc,
4495+
double* scale );
44904496

44914497
lapack_int LAPACKE_strtri( int matrix_layout, char uplo, char diag, lapack_int n,
44924498
float* a, lapack_int lda );
@@ -10199,6 +10205,13 @@ lapack_int LAPACKE_dtrsyl3_work( int matrix_layout, char trana, char tranb,
1019910205
double* c, lapack_int ldc, double* scale,
1020010206
lapack_int* iwork, lapack_int liwork,
1020110207
double* swork, lapack_int ldswork );
10208+
lapack_int LAPACKE_ztrsyl3_work( int matrix_layout, char trana, char tranb,
10209+
lapack_int isgn, lapack_int m, lapack_int n,
10210+
const lapack_complex_double* a, lapack_int lda,
10211+
const lapack_complex_double* b, lapack_int ldb,
10212+
lapack_complex_double* c, lapack_int ldc,
10213+
double* scale, double* swork,
10214+
lapack_int ldswork );
1020210215

1020310216
lapack_int LAPACKE_strtri_work( int matrix_layout, char uplo, char diag,
1020410217
lapack_int n, float* a, lapack_int lda );

‎LAPACKE/src/CMakeLists.txt‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -557,6 +557,8 @@ lapacke_ctrsna.c
557557
lapacke_ctrsna_work.c
558558
lapacke_ctrsyl.c
559559
lapacke_ctrsyl_work.c
560+
lapacke_ctrsyl3.c
561+
lapacke_ctrsyl3_work.c
560562
lapacke_ctrtri.c
561563
lapacke_ctrtri_work.c
562564
lapacke_ctrtrs.c
@@ -2318,6 +2320,8 @@ lapacke_ztrsna.c
23182320
lapacke_ztrsna_work.c
23192321
lapacke_ztrsyl.c
23202322
lapacke_ztrsyl_work.c
2323+
lapacke_ztrsyl3.c
2324+
lapacke_ztrsyl3_work.c
23212325
lapacke_ztrtri.c
23222326
lapacke_ztrtri_work.c
23232327
lapacke_ztrtrs.c

‎LAPACKE/src/Makefile‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -604,6 +604,8 @@ lapacke_ctrsna.o \
604604
lapacke_ctrsna_work.o \
605605
lapacke_ctrsyl.o \
606606
lapacke_ctrsyl_work.o \
607+
lapacke_ctrsyl3.o \
608+
lapacke_ctrsyl3_work.o \
607609
lapacke_ctrtri.o \
608610
lapacke_ctrtri_work.o \
609611
lapacke_ctrtrs.o \
@@ -2360,6 +2362,8 @@ lapacke_ztrsna.o \
23602362
lapacke_ztrsna_work.o \
23612363
lapacke_ztrsyl.o \
23622364
lapacke_ztrsyl_work.o \
2365+
lapacke_ztrsyl3.o \
2366+
lapacke_ztrsyl3_work.o \
23632367
lapacke_ztrtri.o \
23642368
lapacke_ztrtri_work.o \
23652369
lapacke_ztrtrs.o \

‎LAPACKE/src/lapacke_ctrsyl3.c‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
#include "lapacke_utils.h"
2+
3+
lapack_int LAPACKE_ctrsyl3( int matrix_layout, char trana, char tranb,
4+
lapack_int isgn, lapack_int m, lapack_int n,
5+
const lapack_complex_float* a, lapack_int lda,
6+
const lapack_complex_float* b, lapack_int ldb,
7+
lapack_complex_float* c, lapack_int ldc,
8+
float* scale )
9+
{
10+
lapack_int info = 0;
11+
float swork_query[2];
12+
float* swork = NULL;
13+
lapack_int ldswork = -1;
14+
lapack_int swork_size = -1;
15+
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
16+
LAPACKE_xerbla( "LAPACKE_ctrsyl3", -1 );
17+
return -1;
18+
}
19+
#ifndef LAPACK_DISABLE_NAN_CHECK
20+
if( LAPACKE_get_nancheck() ) {
21+
/* Optionally check input matrices for NaNs */
22+
if( LAPACKE_cge_nancheck( matrix_layout, m, m, a, lda ) ) {
23+
return -7;
24+
}
25+
if( LAPACKE_cge_nancheck( matrix_layout, n, n, b, ldb ) ) {
26+
return -9;
27+
}
28+
if( LAPACKE_cge_nancheck( matrix_layout, m, n, c, ldc ) ) {
29+
return -11;
30+
}
31+
}
32+
#endif
33+
/* Query optimal working array sizes */
34+
info = LAPACKE_ctrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, lda,
35+
b, ldb, c, ldc, scale, swork_query, ldswork );
36+
if( info != 0 ) {
37+
goto exit_level_0;
38+
}
39+
ldswork = swork_query[0];
40+
swork_size = ldswork * swork_query[1];
41+
swork = (float*)LAPACKE_malloc( sizeof(float) * swork_size);
42+
if( swork == NULL ) {
43+
info = LAPACK_WORK_MEMORY_ERROR;
44+
goto exit_level_0;
45+
}
46+
/* Call middle-level interface */
47+
info = LAPACKE_ctrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a,
48+
lda, b, ldb, c, ldc, scale, swork, ldswork );
49+
/* Release memory and exit */
50+
LAPACKE_free( swork );
51+
exit_level_0:
52+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
53+
LAPACKE_xerbla( "LAPACKE_ctrsyl3", info );
54+
}
55+
return info;
56+
}

‎LAPACKE/src/lapacke_ctrsyl3_work.c‎

Lines changed: 88 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,88 @@
1+
#include "lapacke_utils.h"
2+
3+
lapack_int LAPACKE_ctrsyl3_work( int matrix_layout, char trana, char tranb,
4+
lapack_int isgn, lapack_int m, lapack_int n,
5+
const lapack_complex_float* a, lapack_int lda,
6+
const lapack_complex_float* b, lapack_int ldb,
7+
lapack_complex_float* c, lapack_int ldc,
8+
float* scale, float* swork,
9+
lapack_int ldswork )
10+
{
11+
lapack_int info = 0;
12+
if( matrix_layout == LAPACK_COL_MAJOR ) {
13+
/* Call LAPACK function and adjust info */
14+
LAPACK_ctrsyl3( &trana, &tranb, &isgn, &m, &n, a, &lda, b, &ldb, c, &ldc,
15+
scale, swork, &ldswork, &info );
16+
if( info < 0 ) {
17+
info = info - 1;
18+
}
19+
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
20+
lapack_int lda_t = MAX(1,m);
21+
lapack_int ldb_t = MAX(1,n);
22+
lapack_int ldc_t = MAX(1,m);
23+
lapack_complex_float* a_t = NULL;
24+
lapack_complex_float* b_t = NULL;
25+
lapack_complex_float* c_t = NULL;
26+
/* Check leading dimension(s) */
27+
if( lda < m ) {
28+
info = -8;
29+
LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info );
30+
return info;
31+
}
32+
if( ldb < n ) {
33+
info = -10;
34+
LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info );
35+
return info;
36+
}
37+
if( ldc < n ) {
38+
info = -12;
39+
LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info );
40+
return info;
41+
}
42+
/* Allocate memory for temporary array(s) */
43+
a_t = (lapack_complex_float*)
44+
LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,m) );
45+
if( a_t == NULL ) {
46+
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
47+
goto exit_level_0;
48+
}
49+
b_t = (lapack_complex_float*)
50+
LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) );
51+
if( b_t == NULL ) {
52+
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
53+
goto exit_level_1;
54+
}
55+
c_t = (lapack_complex_float*)
56+
LAPACKE_malloc( sizeof(lapack_complex_float) * ldc_t * MAX(1,n) );
57+
if( c_t == NULL ) {
58+
info = LAPACK_TRANSPOSE_MEMORY_ERROR;
59+
goto exit_level_2;
60+
}
61+
/* Transpose input matrices */
62+
LAPACKE_cge_trans( matrix_layout, m, m, a, lda, a_t, lda_t );
63+
LAPACKE_cge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t );
64+
LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
65+
/* Call LAPACK function and adjust info */
66+
LAPACK_ctrsyl3( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t,
67+
c_t, &ldc_t, scale, swork, &ldswork, &info );
68+
if( info < 0 ) {
69+
info = info - 1;
70+
}
71+
/* Transpose output matrices */
72+
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
73+
/* Release memory and exit */
74+
LAPACKE_free( c_t );
75+
exit_level_2:
76+
LAPACKE_free( b_t );
77+
exit_level_1:
78+
LAPACKE_free( a_t );
79+
exit_level_0:
80+
if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
81+
LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info );
82+
}
83+
} else {
84+
info = -1;
85+
LAPACKE_xerbla( "LAPACKE_ctrsyl3_work", info );
86+
}
87+
return info;
88+
}

‎LAPACKE/src/lapacke_ztrsyl3.c‎

Lines changed: 56 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,56 @@
1+
#include "lapacke_utils.h"
2+
3+
lapack_int LAPACKE_ztrsyl3( int matrix_layout, char trana, char tranb,
4+
lapack_int isgn, lapack_int m, lapack_int n,
5+
const lapack_complex_double* a, lapack_int lda,
6+
const lapack_complex_double* b, lapack_int ldb,
7+
lapack_complex_double* c, lapack_int ldc,
8+
double* scale )
9+
{
10+
lapack_int info = 0;
11+
double swork_query[2];
12+
double* swork = NULL;
13+
lapack_int ldswork = -1;
14+
lapack_int swork_size = -1;
15+
if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
16+
LAPACKE_xerbla( "LAPACKE_ztrsyl3", -1 );
17+
return -1;
18+
}
19+
#ifndef LAPACK_DISABLE_NAN_CHECK
20+
if( LAPACKE_get_nancheck() ) {
21+
/* Optionally check input matrices for NaNs */
22+
if( LAPACKE_zge_nancheck( matrix_layout, m, m, a, lda ) ) {
23+
return -7;
24+
}
25+
if( LAPACKE_zge_nancheck( matrix_layout, n, n, b, ldb ) ) {
26+
return -9;
27+
}
28+
if( LAPACKE_zge_nancheck( matrix_layout, m, n, c, ldc ) ) {
29+
return -11;
30+
}
31+
}
32+
#endif
33+
/* Query optimal working array sizes */
34+
info = LAPACKE_ztrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a, lda,
35+
b, ldb, c, ldc, scale, swork_query, ldswork );
36+
if( info != 0 ) {
37+
goto exit_level_0;
38+
}
39+
ldswork = swork_query[0];
40+
swork_size = ldswork * swork_query[1];
41+
swork = (double*)LAPACKE_malloc( sizeof(double) * swork_size);
42+
if( swork == NULL ) {
43+
info = LAPACK_WORK_MEMORY_ERROR;
44+
goto exit_level_0;
45+
}
46+
/* Call middle-level interface */
47+
info = LAPACKE_ztrsyl3_work( matrix_layout, trana, tranb, isgn, m, n, a,
48+
lda, b, ldb, c, ldc, scale, swork, ldswork );
49+
/* Release memory and exit */
50+
LAPACKE_free( swork );
51+
exit_level_0:
52+
if( info == LAPACK_WORK_MEMORY_ERROR ) {
53+
LAPACKE_xerbla( "LAPACKE_ztrsyl3", info );
54+
}
55+
return info;
56+
}

0 commit comments

Comments
 (0)