Skip to content

Commit 87cb1d1

Browse files
STCE2023STCE2023
committed
Added trapezoidal transpositions to LAPACKE_?larfb_work.
1 parent c91f13e commit 87cb1d1

File tree

4 files changed

+68
-160
lines changed

4 files changed

+68
-160
lines changed

‎LAPACKE/src/lapacke_clarfb_work.c

Lines changed: 17 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,8 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
4242
{
4343
lapack_int info = 0;
4444
lapack_int nrows_v, ncols_v;
45+
lapack_logical left, col, forward;
46+
char uplo;
4547
lapack_int ldc_t, ldt_t, ldv_t;
4648
lapack_complex_float *v_t = NULL, *t_t = NULL, *c_t = NULL;
4749
if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -52,16 +54,14 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
5254
info = info - 1;
5355
}
5456
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
55-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
56-
LAPACKE_lsame( side, 'l' ) ) ? m :
57-
( ( LAPACKE_lsame( storev, 'c' ) &&
58-
LAPACKE_lsame( side, 'r' ) ) ? n :
59-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
60-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
61-
( ( LAPACKE_lsame( storev, 'r' ) &&
62-
LAPACKE_lsame( side, 'l' ) ) ? m :
63-
( ( LAPACKE_lsame( storev, 'r' ) &&
64-
LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
57+
left = LAPACKE_lsame( side, 'l' );
58+
col = LAPACKE_lsame( storev, 'c' );
59+
forward = LAPACKE_lsame( direct, 'f' );
60+
61+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
62+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
63+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
64+
6565
ldc_t = MAX(1,m);
6666
ldt_t = MAX(1,k);
6767
ldv_t = MAX(1,nrows_v);
@@ -81,6 +81,11 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
8181
LAPACKE_xerbla( "LAPACKE_clarfb_work", info );
8282
return info;
8383
}
84+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
85+
info = -8;
86+
LAPACKE_xerbla( "LAPACKE_clarfb_work", info );
87+
return info;
88+
}
8489
/* Allocate memory for temporary array(s) */
8590
v_t = (lapack_complex_float*)
8691
LAPACKE_malloc( sizeof(lapack_complex_float) *
@@ -102,36 +107,8 @@ lapack_int LAPACKE_clarfb_work( int matrix_layout, char side, char trans,
102107
goto exit_level_2;
103108
}
104109
/* Transpose input matrices */
105-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
106-
LAPACKE_ctr_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
107-
LAPACKE_cge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
108-
&v_t[k], ldv_t );
109-
} else if( LAPACKE_lsame( storev, 'c' ) &&
110-
LAPACKE_lsame( direct, 'b' ) ) {
111-
if( k > nrows_v ) {
112-
LAPACKE_xerbla( "LAPACKE_clarfb_work", -8 );
113-
return -8;
114-
}
115-
LAPACKE_ctr_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
116-
ldv, &v_t[nrows_v-k], ldv_t );
117-
LAPACKE_cge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
118-
ldv_t );
119-
} else if( LAPACKE_lsame( storev, 'r' ) &&
120-
LAPACKE_lsame( direct, 'f' ) ) {
121-
LAPACKE_ctr_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
122-
LAPACKE_cge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
123-
&v_t[k*ldv_t], ldv_t );
124-
} else if( LAPACKE_lsame( storev, 'r' ) &&
125-
LAPACKE_lsame( direct, 'b' ) ) {
126-
if( k > ncols_v ) {
127-
LAPACKE_xerbla( "LAPACKE_clarfb_work", -8 );
128-
return -8;
129-
}
130-
LAPACKE_ctr_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
131-
&v_t[(ncols_v-k)*ldv_t], ldv_t );
132-
LAPACKE_cge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
133-
ldv_t );
134-
}
110+
LAPACKE_ctz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
111+
v, ldv, v_t, ldv_t );
135112
LAPACKE_cge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
136113
LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
137114
/* Call LAPACK function and adjust info */

‎LAPACKE/src/lapacke_dlarfb_work.c

Lines changed: 17 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
4141
{
4242
lapack_int info = 0;
4343
lapack_int nrows_v, ncols_v;
44+
lapack_logical left, col, forward;
45+
char uplo;
4446
lapack_int ldc_t, ldt_t, ldv_t;
4547
double *v_t = NULL, *t_t = NULL, *c_t = NULL;
4648
if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -51,16 +53,14 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
5153
info = info - 1;
5254
}
5355
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
54-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
55-
LAPACKE_lsame( side, 'l' ) ) ? m :
56-
( ( LAPACKE_lsame( storev, 'c' ) &&
57-
LAPACKE_lsame( side, 'r' ) ) ? n :
58-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
59-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
60-
( ( LAPACKE_lsame( storev, 'r' ) &&
61-
LAPACKE_lsame( side, 'l' ) ) ? m :
62-
( ( LAPACKE_lsame( storev, 'r' ) &&
63-
LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
56+
left = LAPACKE_lsame( side, 'l' );
57+
col = LAPACKE_lsame( storev, 'c' );
58+
forward = LAPACKE_lsame( direct, 'f' );
59+
60+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
61+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
62+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
63+
6464
ldc_t = MAX(1,m);
6565
ldt_t = MAX(1,k);
6666
ldv_t = MAX(1,nrows_v);
@@ -80,6 +80,11 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
8080
LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
8181
return info;
8282
}
83+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
84+
info = -8;
85+
LAPACKE_xerbla( "LAPACKE_dlarfb_work", info );
86+
return info;
87+
}
8388
/* Allocate memory for temporary array(s) */
8489
v_t = (double*)
8590
LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,ncols_v) );
@@ -98,36 +103,8 @@ lapack_int LAPACKE_dlarfb_work( int matrix_layout, char side, char trans,
98103
goto exit_level_2;
99104
}
100105
/* Transpose input matrices */
101-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
102-
LAPACKE_dtr_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
103-
LAPACKE_dge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
104-
&v_t[k], ldv_t );
105-
} else if( LAPACKE_lsame( storev, 'c' ) &&
106-
LAPACKE_lsame( direct, 'b' ) ) {
107-
if( k > nrows_v ) {
108-
LAPACKE_xerbla( "LAPACKE_dlarfb_work", -8 );
109-
return -8;
110-
}
111-
LAPACKE_dtr_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
112-
ldv, &v_t[nrows_v-k], ldv_t );
113-
LAPACKE_dge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
114-
ldv_t );
115-
} else if( LAPACKE_lsame( storev, 'r' ) &&
116-
LAPACKE_lsame( direct, 'f' ) ) {
117-
LAPACKE_dtr_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
118-
LAPACKE_dge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
119-
&v_t[k*ldv_t], ldv_t );
120-
} else if( LAPACKE_lsame( storev, 'r' ) &&
121-
LAPACKE_lsame( direct, 'b' ) ) {
122-
if( k > ncols_v ) {
123-
LAPACKE_xerbla( "LAPACKE_dlarfb_work", -8 );
124-
return -8;
125-
}
126-
LAPACKE_dtr_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
127-
&v_t[(ncols_v-k)*ldv_t], ldv_t );
128-
LAPACKE_dge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
129-
ldv_t );
130-
}
106+
LAPACKE_dtz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
107+
v, ldv, v_t, ldv_t );
131108
LAPACKE_dge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
132109
LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
133110
/* Call LAPACK function and adjust info */

‎LAPACKE/src/lapacke_slarfb_work.c

Lines changed: 17 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,8 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
4141
{
4242
lapack_int info = 0;
4343
lapack_int nrows_v, ncols_v;
44+
lapack_logical left, col, forward;
45+
char uplo;
4446
lapack_int ldc_t, ldt_t, ldv_t;
4547
float *v_t = NULL, *t_t = NULL, *c_t = NULL;
4648
if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -51,16 +53,14 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
5153
info = info - 1;
5254
}
5355
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
54-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
55-
LAPACKE_lsame( side, 'l' ) ) ? m :
56-
( ( LAPACKE_lsame( storev, 'c' ) &&
57-
LAPACKE_lsame( side, 'r' ) ) ? n :
58-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
59-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
60-
( ( LAPACKE_lsame( storev, 'r' ) &&
61-
LAPACKE_lsame( side, 'l' ) ) ? m :
62-
( ( LAPACKE_lsame( storev, 'r' ) &&
63-
LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
56+
left = LAPACKE_lsame( side, 'l' );
57+
col = LAPACKE_lsame( storev, 'c' );
58+
forward = LAPACKE_lsame( direct, 'f' );
59+
60+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
61+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
62+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
63+
6464
ldc_t = MAX(1,m);
6565
ldt_t = MAX(1,k);
6666
ldv_t = MAX(1,nrows_v);
@@ -80,6 +80,11 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
8080
LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
8181
return info;
8282
}
83+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
84+
info = -8;
85+
LAPACKE_xerbla( "LAPACKE_slarfb_work", info );
86+
return info;
87+
}
8388
/* Allocate memory for temporary array(s) */
8489
v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,ncols_v) );
8590
if( v_t == NULL ) {
@@ -97,36 +102,8 @@ lapack_int LAPACKE_slarfb_work( int matrix_layout, char side, char trans,
97102
goto exit_level_2;
98103
}
99104
/* Transpose input matrices */
100-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
101-
LAPACKE_str_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
102-
LAPACKE_sge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
103-
&v_t[k], ldv_t );
104-
} else if( LAPACKE_lsame( storev, 'c' ) &&
105-
LAPACKE_lsame( direct, 'b' ) ) {
106-
if( k > nrows_v ) {
107-
LAPACKE_xerbla( "LAPACKE_slarfb_work", -8 );
108-
return -8;
109-
}
110-
LAPACKE_str_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
111-
ldv, &v_t[nrows_v-k], ldv_t );
112-
LAPACKE_sge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
113-
ldv_t );
114-
} else if( LAPACKE_lsame( storev, 'r' ) &&
115-
LAPACKE_lsame( direct, 'f' ) ) {
116-
LAPACKE_str_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
117-
LAPACKE_sge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
118-
&v_t[k*ldv_t], ldv_t );
119-
} else if( LAPACKE_lsame( storev, 'r' ) &&
120-
LAPACKE_lsame( direct, 'b' ) ) {
121-
if( k > ncols_v ) {
122-
LAPACKE_xerbla( "LAPACKE_slarfb_work", -8 );
123-
return -8;
124-
}
125-
LAPACKE_str_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
126-
&v_t[(ncols_v-k)*ldv_t], ldv_t );
127-
LAPACKE_sge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
128-
ldv_t );
129-
}
105+
LAPACKE_stz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
106+
v, ldv, v_t, ldv_t );
130107
LAPACKE_sge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
131108
LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
132109
/* Call LAPACK function and adjust info */

‎LAPACKE/src/lapacke_zlarfb_work.c

Lines changed: 17 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -42,6 +42,8 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
4242
{
4343
lapack_int info = 0;
4444
lapack_int nrows_v, ncols_v;
45+
lapack_logical left, col, forward;
46+
char uplo;
4547
lapack_int ldc_t, ldt_t, ldv_t;
4648
lapack_complex_double *v_t = NULL, *t_t = NULL, *c_t = NULL;
4749
if( matrix_layout == LAPACK_COL_MAJOR ) {
@@ -52,16 +54,14 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
5254
info = info - 1;
5355
}
5456
} else if( matrix_layout == LAPACK_ROW_MAJOR ) {
55-
nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
56-
LAPACKE_lsame( side, 'l' ) ) ? m :
57-
( ( LAPACKE_lsame( storev, 'c' ) &&
58-
LAPACKE_lsame( side, 'r' ) ) ? n :
59-
( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
60-
ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
61-
( ( LAPACKE_lsame( storev, 'r' ) &&
62-
LAPACKE_lsame( side, 'l' ) ) ? m :
63-
( ( LAPACKE_lsame( storev, 'r' ) &&
64-
LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
57+
left = LAPACKE_lsame( side, 'l' );
58+
col = LAPACKE_lsame( storev, 'c' );
59+
forward = LAPACKE_lsame( direct, 'f' );
60+
61+
nrows_v = ( col && left ) ? m : ( ( col && !left ) ? n : ( !col ? k : 1) );
62+
ncols_v = ( !col && left ) ? m : ( ( !col && !left ) ? n : ( col ? k : 1 ) );
63+
uplo = ( ( left && col ) || !( left || col ) ) ? 'l' : 'u';
64+
6565
ldc_t = MAX(1,m);
6666
ldt_t = MAX(1,k);
6767
ldv_t = MAX(1,nrows_v);
@@ -81,6 +81,11 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
8181
LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
8282
return info;
8383
}
84+
if( !forward && ( col && k > nrows_v ) || ( !col && k > ncols_v )) {
85+
info = -8;
86+
LAPACKE_xerbla( "LAPACKE_zlarfb_work", info );
87+
return info;
88+
}
8489
/* Allocate memory for temporary array(s) */
8590
v_t = (lapack_complex_double*)
8691
LAPACKE_malloc( sizeof(lapack_complex_double) *
@@ -102,36 +107,8 @@ lapack_int LAPACKE_zlarfb_work( int matrix_layout, char side, char trans,
102107
goto exit_level_2;
103108
}
104109
/* Transpose input matrices */
105-
if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
106-
LAPACKE_ztr_trans( matrix_layout, 'l', 'u', k, v, ldv, v_t, ldv_t );
107-
LAPACKE_zge_trans( matrix_layout, nrows_v-k, ncols_v, &v[k*ldv], ldv,
108-
&v_t[k], ldv_t );
109-
} else if( LAPACKE_lsame( storev, 'c' ) &&
110-
LAPACKE_lsame( direct, 'b' ) ) {
111-
if( k > nrows_v ) {
112-
LAPACKE_xerbla( "LAPACKE_zlarfb_work", -8 );
113-
return -8;
114-
}
115-
LAPACKE_ztr_trans( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv],
116-
ldv, &v_t[nrows_v-k], ldv_t );
117-
LAPACKE_zge_trans( matrix_layout, nrows_v-k, ncols_v, v, ldv, v_t,
118-
ldv_t );
119-
} else if( LAPACKE_lsame( storev, 'r' ) &&
120-
LAPACKE_lsame( direct, 'f' ) ) {
121-
LAPACKE_ztr_trans( matrix_layout, 'u', 'u', k, v, ldv, v_t, ldv_t );
122-
LAPACKE_zge_trans( matrix_layout, nrows_v, ncols_v-k, &v[k], ldv,
123-
&v_t[k*ldv_t], ldv_t );
124-
} else if( LAPACKE_lsame( storev, 'r' ) &&
125-
LAPACKE_lsame( direct, 'b' ) ) {
126-
if( k > ncols_v ) {
127-
LAPACKE_xerbla( "LAPACKE_zlarfb_work", -8 );
128-
return -8;
129-
}
130-
LAPACKE_ztr_trans( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv,
131-
&v_t[(ncols_v-k)*ldv_t], ldv_t );
132-
LAPACKE_zge_trans( matrix_layout, nrows_v, ncols_v-k, v, ldv, v_t,
133-
ldv_t );
134-
}
110+
LAPACKE_ztz_trans( matrix_layout, direct, uplo, 'u', nrows_v, ncols_v,
111+
v, ldv, v_t, ldv_t );
135112
LAPACKE_zge_trans( matrix_layout, k, k, t, ldt, t_t, ldt_t );
136113
LAPACKE_zge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
137114
/* Call LAPACK function and adjust info */

0 commit comments

Comments
 (0)