void init_aa0(unsigned char **aa0, int n0, int nm0,
unsigned char **aa0s, unsigned char **aa1s,
int qframe, int qshuffle_flg, int max_tot,
struct pstruct *ppst, void **f_str, void **qf_str,
void *my_rand_state) {
int id;
/* note that aa[5,4,3,2] are never used, but are provided so that frame
can range from 0 .. 5; likewise for f_str[5..2] */
aa0[5] = aa0[4] = aa0[3] = aa0[2] = aa0[1] = aa0[0];
/* zero out for SSE2/ALTIVEC -- make sure this is ALWAYS done */
for (id=0; id < SEQ_PAD; id++) aa0[0][n0+id] = '\0';
init_work (aa0[0], n0, ppst, &f_str[0]);
f_str[5] = f_str[4] = f_str[3] = f_str[2] = f_str[1] = f_str[0];
if (qframe == 2) {
if ((aa0[1]=(unsigned char *)calloc((size_t)n0+2+SEQ_PAD,sizeof(unsigned char)))==NULL) {
fprintf(stderr," cannot allocate aa01[%d]\n", n0);
}
*aa0[1]='\0';
aa0[1]++;
memcpy(aa0[1],aa0[0],n0+1);
/* for ALTIVEC/SSE2, must pad with 16 NULL's */
for (id=0; id<SEQ_PAD; id++) {aa0[1][n0+id]=0;}
revcomp(aa0[1],n0,ppst->c_nt);
init_work (aa0[1], n0, ppst, &f_str[1]);
}
if (qshuffle_flg) {
if ((*aa0s=(unsigned char *)calloc(n0+2+SEQ_PAD,sizeof(char)))==NULL) {
fprintf(stderr,"cannot allocate aa0s[%d]\n",n0+2);
exit(1);
}
**aa0s='\0';
(*aa0s)++;
memcpy(*aa0s,aa0[0],n0);
qshuffle(*aa0s,n0,nm0, my_rand_state);
/* for SSE2/ALTIVEC, must pad with 16 NULL's */
for (id=0; id<SEQ_PAD; id++) {(*aa0s)[n0+id]=0;}
init_work (*aa0s, n0, ppst, qf_str);
}
/* always allocate shuffle space */
if((*aa1s=calloc(max_tot+1,sizeof(char))) == NULL) {
fprintf(stderr,"unable to allocate shuffled library sequence [%d]\n", max_tot);
exit(1);
}
else {
**aa1s=0;
(*aa1s)++;
}
}
int main(int argc, char *argv[])
{
getcwd(cwd, 999);
arg0 = argv[0];
arg1 = argc ? argv[1] : NULL;
/* LOAD FILES AND STUFF HERE */
init_work(argc ? argv[1] : NULL);
init_ui();
#ifdef USE_JOYSTICK
printf("Initializing joystick...\n");
signal(SIGVTALRM,joy_alarm);
joy_fd = open ("/dev/input/js0", O_RDONLY | O_NONBLOCK);
#endif
idle_id = gtk_idle_add (iterate, NULL);
system("xset s noblank");
system("xset s off");
system("xset -dpms");
/* -------------------------------------- */
gtk_main();
gdk_flush ();
/* -------------------------------------- */
system("xset +dpms");
system("xset s on");
system("xset s blank");
flynn_exit(0);
}
int regulatory_init(void)
{
int r = 0;
mutex_init(®core_mutex);
spin_lock_init(®_requests_lock);
init_work(®_work);
r = reglib_core_init(&ops);
if (r)
return r;
r = regulatory_hint_core("00");
if (r)
return r;
return r;
}
timer_t *timer_setup(int time_val, int type, timer_callback_func callback, void *callback_arg)
{
INT8U perr;
OS_TMR *tmr;
if (time_val < 100)
time_val = 100;
time_val = time_val * OS_TMR_CFG_TICKS_PER_SEC / 1000;
if ((callback == 0))
{
p_err("setup_timer err arg\n");
return 0;
}
if (type)
//== 1 repeat
{
p_dbg("repeat:%d\n", time_val);
tmr = OSTmrCreate(time_val, time_val, OS_TMR_OPT_PERIODIC, (OS_TMR_CALLBACK)callback, callback_arg, "", &perr);
}
else
{
p_dbg("one short:%d\n", time_val);
tmr = OSTmrCreate(time_val, time_val, OS_TMR_OPT_ONE_SHOT, (OS_TMR_CALLBACK)callback, callback_arg, "", &perr);
}
if (perr != OS_ERR_NONE)
{
tmr = 0;
p_err("setup_timer err\n");
}
tmr->priv = mem_malloc(sizeof(struct work_struct));
if(!tmr->priv){
OSTmrDel(tmr, &perr);
return 0;
}
init_work(tmr->priv, callback, callback_arg);
return (timer_t*)tmr;
}
int main(void)
{
/* Local scalars */
char compz, compz_i;
lapack_int n, n_i;
lapack_int ldz, ldz_i;
lapack_int ldz_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *d = NULL, *d_i = NULL;
float *e = NULL, *e_i = NULL;
lapack_complex_float *z = NULL, *z_i = NULL;
float *work = NULL, *work_i = NULL;
float *d_save = NULL;
float *e_save = NULL;
lapack_complex_float *z_save = NULL;
lapack_complex_float *z_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_csteqr( &compz, &n, &ldz );
ldz_r = n+2;
compz_i = compz;
n_i = n;
ldz_i = ldz;
/* Allocate memory for the LAPACK routine arrays */
d = (float *)LAPACKE_malloc( n * sizeof(float) );
e = (float *)LAPACKE_malloc( (n-1) * sizeof(float) );
z = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * sizeof(lapack_complex_float) );
work = (float *)LAPACKE_malloc( ((MAX(1,2*n-2))) * sizeof(float) );
/* Allocate memory for the C interface function arrays */
d_i = (float *)LAPACKE_malloc( n * sizeof(float) );
e_i = (float *)LAPACKE_malloc( (n-1) * sizeof(float) );
z_i = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * sizeof(lapack_complex_float) );
work_i = (float *)LAPACKE_malloc( ((MAX(1,2*n-2))) * sizeof(float) );
/* Allocate memory for the backup arrays */
d_save = (float *)LAPACKE_malloc( n * sizeof(float) );
e_save = (float *)LAPACKE_malloc( (n-1) * sizeof(float) );
z_save = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
z_r = (lapack_complex_float *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_d( n, d );
init_e( (n-1), e );
init_z( ldz*n, z );
init_work( (MAX(1,2*n-2)), work );
/* Backup the ouptut arrays */
for( i = 0; i < n; i++ ) {
d_save[i] = d[i];
}
for( i = 0; i < (n-1); i++ ) {
e_save[i] = e[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_save[i] = z[i];
}
/* Call the LAPACK routine */
csteqr_( &compz, &n, d, e, z, &ldz, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_csteqr_work( LAPACK_COL_MAJOR, compz_i, n_i, d_i, e_i, z_i,
ldz_i, work_i );
failed = compare_csteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to csteqr\n" );
} else {
printf( "FAILED: column-major middle-level interface to csteqr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_csteqr( LAPACK_COL_MAJOR, compz_i, n_i, d_i, e_i, z_i,
ldz_i );
failed = compare_csteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to csteqr\n" );
} else {
printf( "FAILED: column-major high-level interface to csteqr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
work_i[i] = work[i];
}
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
}
info_i = LAPACKE_csteqr_work( LAPACK_ROW_MAJOR, compz_i, n_i, d_i, e_i, z_r,
ldz_r, work_i );
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
}
failed = compare_csteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to csteqr\n" );
} else {
printf( "FAILED: row-major middle-level interface to csteqr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < (MAX(1,2*n-2)); i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
}
info_i = LAPACKE_csteqr( LAPACK_ROW_MAJOR, compz_i, n_i, d_i, e_i, z_r,
ldz_r );
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
}
failed = compare_csteqr( d, d_i, e, e_i, z, z_i, info, info_i, compz, ldz,
n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to csteqr\n" );
} else {
printf( "FAILED: row-major high-level interface to csteqr\n" );
}
/* Release memory */
if( d != NULL ) {
LAPACKE_free( d );
}
if( d_i != NULL ) {
LAPACKE_free( d_i );
}
if( d_save != NULL ) {
LAPACKE_free( d_save );
}
if( e != NULL ) {
LAPACKE_free( e );
}
if( e_i != NULL ) {
LAPACKE_free( e_i );
}
if( e_save != NULL ) {
LAPACKE_free( e_save );
}
if( z != NULL ) {
LAPACKE_free( z );
}
if( z_i != NULL ) {
LAPACKE_free( z_i );
}
if( z_r != NULL ) {
LAPACKE_free( z_r );
}
if( z_save != NULL ) {
LAPACKE_free( z_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int k, k_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *tau = NULL, *tau_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
lapack_complex_double *a_save = NULL;
lapack_complex_double *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zunglq( &m, &n, &k, &lda, &lwork );
lda_r = n+2;
m_i = m;
n_i = n;
k_i = k;
lda_i = lda;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
tau = (lapack_complex_double *)
LAPACKE_malloc( k * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
tau_i = (lapack_complex_double *)
LAPACKE_malloc( k * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
a_save = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_tau( k, tau );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
/* Call the LAPACK routine */
zunglq_( &m, &n, &k, a, &lda, tau, work, &lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunglq_work( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
tau_i, work_i, lwork_i );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zunglq\n" );
} else {
printf( "FAILED: column-major middle-level interface to zunglq\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunglq( LAPACK_COL_MAJOR, m_i, n_i, k_i, a_i, lda_i,
tau_i );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zunglq\n" );
} else {
printf( "FAILED: column-major high-level interface to zunglq\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zunglq_work( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
tau_i, work_i, lwork_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zunglq\n" );
} else {
printf( "FAILED: row-major middle-level interface to zunglq\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < k; i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zunglq( LAPACK_ROW_MAJOR, m_i, n_i, k_i, a_r, lda_r,
tau_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_zunglq( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zunglq\n" );
} else {
printf( "FAILED: row-major high-level interface to zunglq\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char job, job_i;
char compz, compz_i;
lapack_int n, n_i;
lapack_int ilo, ilo_i;
lapack_int ihi, ihi_i;
lapack_int ldh, ldh_i;
lapack_int ldh_r;
lapack_int ldz, ldz_i;
lapack_int ldz_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_float *h = NULL, *h_i = NULL;
lapack_complex_float *w = NULL, *w_i = NULL;
lapack_complex_float *z = NULL, *z_i = NULL;
lapack_complex_float *work = NULL, *work_i = NULL;
lapack_complex_float *h_save = NULL;
lapack_complex_float *w_save = NULL;
lapack_complex_float *z_save = NULL;
lapack_complex_float *h_r = NULL;
lapack_complex_float *z_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_chseqr( &job, &compz, &n, &ilo, &ihi, &ldh, &ldz, &lwork );
ldh_r = n+2;
ldz_r = n+2;
job_i = job;
compz_i = compz;
n_i = n;
ilo_i = ilo;
ihi_i = ihi;
ldh_i = ldh;
ldz_i = ldz;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
h = (lapack_complex_float *)
LAPACKE_malloc( ldh*n * sizeof(lapack_complex_float) );
w = (lapack_complex_float *)
LAPACKE_malloc( n * sizeof(lapack_complex_float) );
z = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * sizeof(lapack_complex_float) );
work = (lapack_complex_float *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
/* Allocate memory for the C interface function arrays */
h_i = (lapack_complex_float *)
LAPACKE_malloc( ldh*n * sizeof(lapack_complex_float) );
w_i = (lapack_complex_float *)
LAPACKE_malloc( n * sizeof(lapack_complex_float) );
z_i = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * sizeof(lapack_complex_float) );
work_i = (lapack_complex_float *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
/* Allocate memory for the backup arrays */
h_save = (lapack_complex_float *)
LAPACKE_malloc( ldh*n * sizeof(lapack_complex_float) );
w_save = (lapack_complex_float *)
LAPACKE_malloc( n * sizeof(lapack_complex_float) );
z_save = (lapack_complex_float *)
LAPACKE_malloc( ldz*n * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
h_r = (lapack_complex_float *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) );
z_r = (lapack_complex_float *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_h( ldh*n, h );
init_w( n, w );
init_z( ldz*n, z );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldh*n; i++ ) {
h_save[i] = h[i];
}
for( i = 0; i < n; i++ ) {
w_save[i] = w[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_save[i] = z[i];
}
/* Call the LAPACK routine */
chseqr_( &job, &compz, &n, &ilo, &ihi, h, &ldh, w, z, &ldz, work, &lwork,
&info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h_save[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_chseqr_work( LAPACK_COL_MAJOR, job_i, compz_i, n_i, ilo_i,
ihi_i, h_i, ldh_i, w_i, z_i, ldz_i, work_i,
lwork_i );
failed = compare_chseqr( h, h_i, w, w_i, z, z_i, info, info_i, compz, ldh,
ldz, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to chseqr\n" );
} else {
printf( "FAILED: column-major middle-level interface to chseqr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h_save[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_chseqr( LAPACK_COL_MAJOR, job_i, compz_i, n_i, ilo_i,
ihi_i, h_i, ldh_i, w_i, z_i, ldz_i );
failed = compare_chseqr( h, h_i, w, w_i, z, z_i, info, info_i, compz, ldh,
ldz, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to chseqr\n" );
} else {
printf( "FAILED: column-major high-level interface to chseqr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h_save[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
}
info_i = LAPACKE_chseqr_work( LAPACK_ROW_MAJOR, job_i, compz_i, n_i, ilo_i,
ihi_i, h_r, ldh_r, w_i, z_r, ldz_r, work_i,
lwork_i );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, h_r, n+2, h_i, ldh );
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
}
failed = compare_chseqr( h, h_i, w, w_i, z, z_i, info, info_i, compz, ldh,
ldz, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to chseqr\n" );
} else {
printf( "FAILED: row-major middle-level interface to chseqr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h_save[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldz*n; i++ ) {
z_i[i] = z_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 );
}
info_i = LAPACKE_chseqr( LAPACK_ROW_MAJOR, job_i, compz_i, n_i, ilo_i,
ihi_i, h_r, ldh_r, w_i, z_r, ldz_r );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, h_r, n+2, h_i, ldh );
if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz );
}
failed = compare_chseqr( h, h_i, w, w_i, z, z_i, info, info_i, compz, ldh,
ldz, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to chseqr\n" );
} else {
printf( "FAILED: row-major high-level interface to chseqr\n" );
}
/* Release memory */
if( h != NULL ) {
LAPACKE_free( h );
}
if( h_i != NULL ) {
LAPACKE_free( h_i );
}
if( h_r != NULL ) {
LAPACKE_free( h_r );
}
if( h_save != NULL ) {
LAPACKE_free( h_save );
}
if( w != NULL ) {
LAPACKE_free( w );
}
if( w_i != NULL ) {
LAPACKE_free( w_i );
}
if( w_save != NULL ) {
LAPACKE_free( w_save );
}
if( z != NULL ) {
LAPACKE_free( z );
}
if( z_i != NULL ) {
LAPACKE_free( z_i );
}
if( z_r != NULL ) {
LAPACKE_free( z_r );
}
if( z_save != NULL ) {
LAPACKE_free( z_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
static bytea *
decrypt_internal(int is_pubenc, int need_text, text *data,
text *key, text *keypsw, text *args)
{
int err;
MBuf *src = NULL,
*dst = NULL;
uint8 tmp[VARHDRSZ];
uint8 *restmp;
bytea *res;
int res_len;
PGP_Context *ctx = NULL;
struct debug_expect ex;
int got_unicode = 0;
init_work(&ctx, need_text, args, &ex);
src = mbuf_create_from_data((uint8 *) VARDATA(data),
VARSIZE(data) - VARHDRSZ);
dst = mbuf_create(VARSIZE(data) + 2048);
/*
* reserve room for header
*/
mbuf_append(dst, tmp, VARHDRSZ);
/*
* set key
*/
if (is_pubenc)
{
uint8 *psw = NULL;
int psw_len = 0;
MBuf *kbuf;
if (keypsw)
{
psw = (uint8 *) VARDATA(keypsw);
psw_len = VARSIZE(keypsw) - VARHDRSZ;
}
kbuf = create_mbuf_from_vardata(key);
err = pgp_set_pubkey(ctx, kbuf, psw, psw_len, 1);
mbuf_free(kbuf);
}
else
err = pgp_set_symkey(ctx, (uint8 *) VARDATA(key),
VARSIZE(key) - VARHDRSZ);
/*
* decrypt
*/
if (err >= 0)
err = pgp_decrypt(ctx, src, dst);
/*
* failed?
*/
if (err < 0)
goto out;
if (ex.expect)
check_expect(ctx, &ex);
/* remember the setting */
got_unicode = pgp_get_unicode_mode(ctx);
out:
if (src)
mbuf_free(src);
if (ctx)
pgp_free(ctx);
if (err)
{
px_set_debug_handler(NULL);
if (dst)
mbuf_free(dst);
ereport(ERROR,
(errcode(ERRCODE_EXTERNAL_ROUTINE_INVOCATION_EXCEPTION),
errmsg("%s", px_strerror(err))));
}
res_len = mbuf_steal_data(dst, &restmp);
mbuf_free(dst);
/* res_len includes VARHDRSZ */
res = (bytea *) restmp;
SET_VARSIZE(res, res_len);
if (need_text && got_unicode)
{
text *utf = convert_from_utf8(res);
if (utf != res)
{
clear_and_pfree(res);
res = utf;
}
}
px_set_debug_handler(NULL);
/*
* add successfull decryptions also into RNG
*/
add_entropy(res, key, keypsw);
return res;
}
int main(void)
{
/* Local scalars */
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
float *d = NULL, *d_i = NULL;
float *e = NULL, *e_i = NULL;
float *tauq = NULL, *tauq_i = NULL;
float *taup = NULL, *taup_i = NULL;
float *work = NULL, *work_i = NULL;
float *a_save = NULL;
float *d_save = NULL;
float *e_save = NULL;
float *tauq_save = NULL;
float *taup_save = NULL;
float *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_sgebrd( &m, &n, &lda, &lwork );
lda_r = n+2;
m_i = m;
n_i = n;
lda_i = lda;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
d = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
e = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
tauq = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
taup = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
d_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
e_i = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
tauq_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
taup_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the backup arrays */
a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
d_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
e_save = (float *)LAPACKE_malloc( ((MIN(m,n)-1)) * sizeof(float) );
tauq_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
taup_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*n, a );
init_d( (MIN(m,n)), d );
init_e( (MIN(m,n)-1), e );
init_tauq( (MIN(m,n)), tauq );
init_taup( (MIN(m,n)), taup );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_save[i] = d[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_save[i] = e[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_save[i] = tauq[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_save[i] = taup[i];
}
/* Call the LAPACK routine */
sgebrd_( &m, &n, a, &lda, d, e, tauq, taup, work, &lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgebrd_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i,
e_i, tauq_i, taup_i, work_i, lwork_i );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to sgebrd\n" );
} else {
printf( "FAILED: column-major middle-level interface to sgebrd\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgebrd( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, d_i, e_i,
tauq_i, taup_i );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to sgebrd\n" );
} else {
printf( "FAILED: column-major high-level interface to sgebrd\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgebrd_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i,
e_i, tauq_i, taup_i, work_i, lwork_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to sgebrd\n" );
} else {
printf( "FAILED: row-major middle-level interface to sgebrd\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (MIN(m,n)-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tauq_i[i] = tauq_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
taup_i[i] = taup_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgebrd( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, d_i, e_i,
tauq_i, taup_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgebrd( a, a_i, d, d_i, e, e_i, tauq, tauq_i, taup, taup_i,
info, info_i, lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to sgebrd\n" );
} else {
printf( "FAILED: row-major high-level interface to sgebrd\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( d != NULL ) {
LAPACKE_free( d );
}
if( d_i != NULL ) {
LAPACKE_free( d_i );
}
if( d_save != NULL ) {
LAPACKE_free( d_save );
}
if( e != NULL ) {
LAPACKE_free( e );
}
if( e_i != NULL ) {
LAPACKE_free( e_i );
}
if( e_save != NULL ) {
LAPACKE_free( e_save );
}
if( tauq != NULL ) {
LAPACKE_free( tauq );
}
if( tauq_i != NULL ) {
LAPACKE_free( tauq_i );
}
if( tauq_save != NULL ) {
LAPACKE_free( tauq_save );
}
if( taup != NULL ) {
LAPACKE_free( taup );
}
if( taup_i != NULL ) {
LAPACKE_free( taup_i );
}
if( taup_save != NULL ) {
LAPACKE_free( taup_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
lapack_int *jpvt = NULL, *jpvt_i = NULL;
float *tau = NULL, *tau_i = NULL;
float *work = NULL, *work_i = NULL;
float *a_save = NULL;
lapack_int *jpvt_save = NULL;
float *tau_save = NULL;
float *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_sgeqpf( &m, &n, &lda );
lda_r = n+2;
m_i = m;
n_i = n;
lda_i = lda;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
jpvt = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
tau = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
jpvt_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
tau_i = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
/* Allocate memory for the backup arrays */
a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
jpvt_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
tau_save = (float *)LAPACKE_malloc( MIN(m,n) * sizeof(float) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*n, a );
init_jpvt( n, jpvt );
init_tau( (MIN(m,n)), tau );
init_work( 3*n, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
for( i = 0; i < n; i++ ) {
jpvt_save[i] = jpvt[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_save[i] = tau[i];
}
/* Call the LAPACK routine */
sgeqpf_( &m, &n, a, &lda, jpvt, tau, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgeqpf_work( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i,
jpvt_i, tau_i, work_i );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to sgeqpf\n" );
} else {
printf( "FAILED: column-major middle-level interface to sgeqpf\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sgeqpf( LAPACK_COL_MAJOR, m_i, n_i, a_i, lda_i, jpvt_i,
tau_i );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to sgeqpf\n" );
} else {
printf( "FAILED: column-major high-level interface to sgeqpf\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgeqpf_work( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r,
jpvt_i, tau_i, work_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to sgeqpf\n" );
} else {
printf( "FAILED: row-major middle-level interface to sgeqpf\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
jpvt_i[i] = jpvt_save[i];
}
for( i = 0; i < (MIN(m,n)); i++ ) {
tau_i[i] = tau_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_sgeqpf( LAPACK_ROW_MAJOR, m_i, n_i, a_r, lda_r, jpvt_i,
tau_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, a_r, n+2, a_i, lda );
failed = compare_sgeqpf( a, a_i, jpvt, jpvt_i, tau, tau_i, info, info_i,
lda, m, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to sgeqpf\n" );
} else {
printf( "FAILED: row-major high-level interface to sgeqpf\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( jpvt != NULL ) {
LAPACKE_free( jpvt );
}
if( jpvt_i != NULL ) {
LAPACKE_free( jpvt_i );
}
if( jpvt_save != NULL ) {
LAPACKE_free( jpvt_save );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( tau_save != NULL ) {
LAPACKE_free( tau_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
static bytea *
encrypt_internal(int is_pubenc, int is_text,
text *data, text *key, text *args)
{
MBuf *src,
*dst;
uint8 tmp[VARHDRSZ];
uint8 *restmp;
bytea *res;
int res_len;
PGP_Context *ctx;
int err;
struct debug_expect ex;
text *tmp_data = NULL;
/*
* Add data and key info RNG.
*/
add_entropy(data, key, NULL);
init_work(&ctx, is_text, args, &ex);
if (is_text && pgp_get_unicode_mode(ctx))
{
tmp_data = convert_to_utf8(data);
if (tmp_data == data)
tmp_data = NULL;
else
data = tmp_data;
}
src = create_mbuf_from_vardata(data);
dst = mbuf_create(VARSIZE(data) + 128);
/*
* reserve room for header
*/
mbuf_append(dst, tmp, VARHDRSZ);
/*
* set key
*/
if (is_pubenc)
{
MBuf *kbuf = create_mbuf_from_vardata(key);
err = pgp_set_pubkey(ctx, kbuf,
NULL, 0, 0);
mbuf_free(kbuf);
}
else
err = pgp_set_symkey(ctx, (uint8 *) VARDATA(key),
VARSIZE(key) - VARHDRSZ);
/*
* encrypt
*/
if (err >= 0)
err = pgp_encrypt(ctx, src, dst);
/*
* check for error
*/
if (err)
{
if (ex.debug)
px_set_debug_handler(NULL);
if (tmp_data)
clear_and_pfree(tmp_data);
pgp_free(ctx);
mbuf_free(src);
mbuf_free(dst);
ereport(ERROR,
(errcode(ERRCODE_EXTERNAL_ROUTINE_INVOCATION_EXCEPTION),
errmsg("%s", px_strerror(err))));
}
/* res_len includes VARHDRSZ */
res_len = mbuf_steal_data(dst, &restmp);
res = (bytea *) restmp;
SET_VARSIZE(res, res_len);
if (tmp_data)
clear_and_pfree(tmp_data);
pgp_free(ctx);
mbuf_free(src);
mbuf_free(dst);
px_set_debug_handler(NULL);
return res;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
char trans, trans_i;
char diag, diag_i;
lapack_int n, n_i;
lapack_int nrhs, nrhs_i;
lapack_int ldb, ldb_i;
lapack_int ldb_r;
lapack_int ldx, ldx_i;
lapack_int ldx_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *ap = NULL, *ap_i = NULL;
float *b = NULL, *b_i = NULL;
float *x = NULL, *x_i = NULL;
float *ferr = NULL, *ferr_i = NULL;
float *berr = NULL, *berr_i = NULL;
float *work = NULL, *work_i = NULL;
lapack_int *iwork = NULL, *iwork_i = NULL;
float *ferr_save = NULL;
float *berr_save = NULL;
float *ap_r = NULL;
float *b_r = NULL;
float *x_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_stprfs( &uplo, &trans, &diag, &n, &nrhs, &ldb, &ldx );
ldb_r = nrhs+2;
ldx_r = nrhs+2;
uplo_i = uplo;
trans_i = trans;
diag_i = diag;
n_i = n;
nrhs_i = nrhs;
ldb_i = ldb;
ldx_i = ldx;
/* Allocate memory for the LAPACK routine arrays */
ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
x = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
work = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the C interface function arrays */
ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) );
b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) );
x_i = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) );
ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) );
iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the backup arrays */
ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) );
/* Allocate memory for the row-major arrays */
ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) );
b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
x_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) );
/* Initialize input arrays */
init_ap( (n*(n+1)/2), ap );
init_b( ldb*nrhs, b );
init_x( ldx*nrhs, x );
init_ferr( nrhs, ferr );
init_berr( nrhs, berr );
init_work( 3*n, work );
init_iwork( n, iwork );
/* Backup the ouptut arrays */
for( i = 0; i < nrhs; i++ ) {
ferr_save[i] = ferr[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_save[i] = berr[i];
}
/* Call the LAPACK routine */
stprfs_( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, x, &ldx, ferr, berr,
work, iwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_stprfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i,
ferr_i, berr_i, work_i, iwork_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to stprfs\n" );
} else {
printf( "FAILED: column-major middle-level interface to stprfs\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_stprfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i, ferr_i,
berr_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to stprfs\n" );
} else {
printf( "FAILED: column-major high-level interface to stprfs\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_stprfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r,
ferr_i, berr_i, work_i, iwork_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to stprfs\n" );
} else {
printf( "FAILED: row-major middle-level interface to stprfs\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 3*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
iwork_i[i] = iwork[i];
}
/* Init row_major arrays */
LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_stprfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r, ferr_i,
berr_i );
failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to stprfs\n" );
} else {
printf( "FAILED: row-major high-level interface to stprfs\n" );
}
/* Release memory */
if( ap != NULL ) {
LAPACKE_free( ap );
}
if( ap_i != NULL ) {
LAPACKE_free( ap_i );
}
if( ap_r != NULL ) {
LAPACKE_free( ap_r );
}
if( b != NULL ) {
LAPACKE_free( b );
}
if( b_i != NULL ) {
LAPACKE_free( b_i );
}
if( b_r != NULL ) {
LAPACKE_free( b_r );
}
if( x != NULL ) {
LAPACKE_free( x );
}
if( x_i != NULL ) {
LAPACKE_free( x_i );
}
if( x_r != NULL ) {
LAPACKE_free( x_r );
}
if( ferr != NULL ) {
LAPACKE_free( ferr );
}
if( ferr_i != NULL ) {
LAPACKE_free( ferr_i );
}
if( ferr_save != NULL ) {
LAPACKE_free( ferr_save );
}
if( berr != NULL ) {
LAPACKE_free( berr );
}
if( berr_i != NULL ) {
LAPACKE_free( berr_i );
}
if( berr_save != NULL ) {
LAPACKE_free( berr_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( iwork != NULL ) {
LAPACKE_free( iwork );
}
if( iwork_i != NULL ) {
LAPACKE_free( iwork_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char side, side_i;
char trans, trans_i;
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int ilo, ilo_i;
lapack_int ihi, ihi_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
/* Declare scalars */
lapack_int r;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *tau = NULL, *tau_i = NULL;
lapack_complex_double *c = NULL, *c_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
lapack_complex_double *c_save = NULL;
lapack_complex_double *a_r = NULL;
lapack_complex_double *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zunmhr( &side, &trans, &m, &n, &ilo, &ihi, &lda, &ldc,
&lwork );
r = LAPACKE_lsame( side, 'l' ) ? m : n;
lda_r = r+2;
ldc_r = n+2;
side_i = side;
trans_i = trans;
m_i = m;
n_i = n;
ilo_i = ilo;
ihi_i = ihi;
lda_i = lda;
ldc_i = ldc;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*m * sizeof(lapack_complex_double) );
tau = (lapack_complex_double *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_double) );
c = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*m * sizeof(lapack_complex_double) );
tau_i = (lapack_complex_double *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_double) );
c_i = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_double) );
/* Allocate memory for the backup arrays */
c_save = (lapack_complex_double *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( r*(r+2) * sizeof(lapack_complex_double) );
c_r = (lapack_complex_double *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*m, a );
init_tau( (m-1), tau );
init_c( ldc*n, c );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldc*n; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
zunmhr_( &side, &trans, &m, &n, &ilo, &ihi, a, &lda, tau, c, &ldc, work,
&lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunmhr_work( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i,
ilo_i, ihi_i, a_i, lda_i, tau_i, c_i, ldc_i,
work_i, lwork_i );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zunmhr\n" );
} else {
printf( "FAILED: column-major middle-level interface to zunmhr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zunmhr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
ihi_i, a_i, lda_i, tau_i, c_i, ldc_i );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zunmhr\n" );
} else {
printf( "FAILED: column-major high-level interface to zunmhr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_zunmhr_work( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i,
ilo_i, ihi_i, a_r, lda_r, tau_i, c_r, ldc_r,
work_i, lwork_i );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zunmhr\n" );
} else {
printf( "FAILED: row-major middle-level interface to zunmhr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*m; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, r, r, a_i, lda, a_r, r+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_zunmhr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, ilo_i,
ihi_i, a_r, lda_r, tau_i, c_r, ldc_r );
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_zunmhr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zunmhr\n" );
} else {
printf( "FAILED: row-major high-level interface to zunmhr\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( c != NULL ) {
LAPACKE_free( c );
}
if( c_i != NULL ) {
LAPACKE_free( c_i );
}
if( c_r != NULL ) {
LAPACKE_free( c_r );
}
if( c_save != NULL ) {
LAPACKE_free( c_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char side, side_i;
char uplo, uplo_i;
char trans, trans_i;
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int info, info_i;
/* Declare scalars */
lapack_int lwork;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_float *ap = NULL, *ap_i = NULL;
lapack_complex_float *tau = NULL, *tau_i = NULL;
lapack_complex_float *c = NULL, *c_i = NULL;
lapack_complex_float *work = NULL, *work_i = NULL;
lapack_complex_float *c_save = NULL;
lapack_complex_float *ap_r = NULL;
lapack_complex_float *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_cupmtr( &side, &uplo, &trans, &m, &n, &ldc );
lwork = MAX(m,n);
ldc_r = n+2;
side_i = side;
uplo_i = uplo;
trans_i = trans;
m_i = m;
n_i = n;
ldc_i = ldc;
/* Allocate memory for the LAPACK routine arrays */
ap = (lapack_complex_float *)
LAPACKE_malloc( ((m*(m+1)/2)) * sizeof(lapack_complex_float) );
tau = (lapack_complex_float *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_float) );
c = (lapack_complex_float *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_float) );
work = (lapack_complex_float *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
/* Allocate memory for the C interface function arrays */
ap_i = (lapack_complex_float *)
LAPACKE_malloc( ((m*(m+1)/2)) * sizeof(lapack_complex_float) );
tau_i = (lapack_complex_float *)
LAPACKE_malloc( (m-1) * sizeof(lapack_complex_float) );
c_i = (lapack_complex_float *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_float) );
work_i = (lapack_complex_float *)
LAPACKE_malloc( lwork * sizeof(lapack_complex_float) );
/* Allocate memory for the backup arrays */
c_save = (lapack_complex_float *)
LAPACKE_malloc( ldc*n * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
ap_r = (lapack_complex_float *)
LAPACKE_malloc( m*(m+1)/2 * sizeof(lapack_complex_float) );
c_r = (lapack_complex_float *)
LAPACKE_malloc( m*(n+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_ap( (m*(m+1)/2), ap );
init_tau( (m-1), tau );
init_c( ldc*n, c );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldc*n; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
cupmtr_( &side, &uplo, &trans, &m, &n, ap, tau, c, &ldc, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cupmtr_work( LAPACK_COL_MAJOR, side_i, uplo_i, trans_i,
m_i, n_i, ap_i, tau_i, c_i, ldc_i, work_i );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to cupmtr\n" );
} else {
printf( "FAILED: column-major middle-level interface to cupmtr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cupmtr( LAPACK_COL_MAJOR, side_i, uplo_i, trans_i, m_i,
n_i, ap_i, tau_i, c_i, ldc_i );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to cupmtr\n" );
} else {
printf( "FAILED: column-major high-level interface to cupmtr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, m, ap_i, ap_r );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_cupmtr_work( LAPACK_ROW_MAJOR, side_i, uplo_i, trans_i,
m_i, n_i, ap_r, tau_i, c_r, ldc_r, work_i );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to cupmtr\n" );
} else {
printf( "FAILED: row-major middle-level interface to cupmtr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (m*(m+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < (m-1); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, m, ap_i, ap_r );
LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_cupmtr( LAPACK_ROW_MAJOR, side_i, uplo_i, trans_i, m_i,
n_i, ap_r, tau_i, c_r, ldc_r );
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_cupmtr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to cupmtr\n" );
} else {
printf( "FAILED: row-major high-level interface to cupmtr\n" );
}
/* Release memory */
if( ap != NULL ) {
LAPACKE_free( ap );
}
if( ap_i != NULL ) {
LAPACKE_free( ap_i );
}
if( ap_r != NULL ) {
LAPACKE_free( ap_r );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( c != NULL ) {
LAPACKE_free( c );
}
if( c_i != NULL ) {
LAPACKE_free( c_i );
}
if( c_r != NULL ) {
LAPACKE_free( c_r );
}
if( c_save != NULL ) {
LAPACKE_free( c_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
double anorm, anorm_i;
double rcond, rcond_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *ap = NULL, *ap_i = NULL;
lapack_int *ipiv = NULL, *ipiv_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
lapack_complex_double *ap_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zhpcon( &uplo, &n, &anorm );
uplo_i = uplo;
n_i = n;
anorm_i = anorm;
/* Allocate memory for the LAPACK routine arrays */
ap = (lapack_complex_double *)
LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_double) );
ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
/* Allocate memory for the C interface function arrays */
ap_i = (lapack_complex_double *)
LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_double) );
ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
/* Allocate memory for the row-major arrays */
ap_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+1)/2 * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_ap( (n*(n+1)/2), ap );
init_ipiv( n, ipiv );
init_work( 2*n, work );
/* Call the LAPACK routine */
zhpcon_( &uplo, &n, ap, ipiv, &anorm, &rcond, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zhpcon_work( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i, ipiv_i,
anorm_i, &rcond_i, work_i );
failed = compare_zhpcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zhpcon\n" );
} else {
printf( "FAILED: column-major middle-level interface to zhpcon\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_zhpcon( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i, ipiv_i,
anorm_i, &rcond_i );
failed = compare_zhpcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zhpcon\n" );
} else {
printf( "FAILED: column-major high-level interface to zhpcon\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
info_i = LAPACKE_zhpcon_work( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r, ipiv_i,
anorm_i, &rcond_i, work_i );
failed = compare_zhpcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zhpcon\n" );
} else {
printf( "FAILED: row-major middle-level interface to zhpcon\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
info_i = LAPACKE_zhpcon( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r, ipiv_i,
anorm_i, &rcond_i );
failed = compare_zhpcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zhpcon\n" );
} else {
printf( "FAILED: row-major high-level interface to zhpcon\n" );
}
/* Release memory */
if( ap != NULL ) {
LAPACKE_free( ap );
}
if( ap_i != NULL ) {
LAPACKE_free( ap_i );
}
if( ap_r != NULL ) {
LAPACKE_free( ap_r );
}
if( ipiv != NULL ) {
LAPACKE_free( ipiv );
}
if( ipiv_i != NULL ) {
LAPACKE_free( ipiv_i );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char vect, vect_i;
char side, side_i;
char trans, trans_i;
lapack_int m, m_i;
lapack_int n, n_i;
lapack_int k, k_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
/* Declare scalars */
lapack_int nq;
lapack_int r;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
float *tau = NULL, *tau_i = NULL;
float *c = NULL, *c_i = NULL;
float *work = NULL, *work_i = NULL;
float *c_save = NULL;
float *a_r = NULL;
float *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_sormbr( &vect, &side, &trans, &m, &n, &k, &lda, &ldc, &lwork );
nq = LAPACKE_lsame( side, 'l' ) ? m : n;
r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
lda_r = MIN(nq,k)+2;
ldc_r = n+2;
vect_i = vect;
side_i = side;
trans_i = trans;
m_i = m;
n_i = n;
k_i = k;
lda_i = lda;
ldc_i = ldc;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( (lda*(MIN(nq,k))) * sizeof(float) );
tau = (float *)LAPACKE_malloc( MIN(nq,k) * sizeof(float) );
c = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( (lda*(MIN(nq,k))) * sizeof(float) );
tau_i = (float *)LAPACKE_malloc( MIN(nq,k) * sizeof(float) );
c_i = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the backup arrays */
c_save = (float *)LAPACKE_malloc( ldc*n * sizeof(float) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( (r*(MIN(nq,k)+2)) * sizeof(float) );
c_r = (float *)LAPACKE_malloc( m*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*(MIN(nq,k)), a );
init_tau( (MIN(nq,k)), tau );
init_c( ldc*n, c );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldc*n; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
sormbr_( &vect, &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
&lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sormbr_work( LAPACK_COL_MAJOR, vect_i, side_i, trans_i,
m_i, n_i, k_i, a_i, lda_i, tau_i, c_i, ldc_i,
work_i, lwork_i );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to sormbr\n" );
} else {
printf( "FAILED: column-major middle-level interface to sormbr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_sormbr( LAPACK_COL_MAJOR, vect_i, side_i, trans_i, m_i,
n_i, k_i, a_i, lda_i, tau_i, c_i, ldc_i );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to sormbr\n" );
} else {
printf( "FAILED: column-major high-level interface to sormbr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, r, MIN(nq, k ), a_i, lda, a_r, MIN(nq,
k)+2);
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_sormbr_work( LAPACK_ROW_MAJOR, vect_i, side_i, trans_i,
m_i, n_i, k_i, a_r, lda_r, tau_i, c_r, ldc_r,
work_i, lwork_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to sormbr\n" );
} else {
printf( "FAILED: row-major middle-level interface to sormbr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*(MIN(nq,k)); i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < (MIN(nq,k)); i++ ) {
tau_i[i] = tau[i];
}
for( i = 0; i < ldc*n; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, r, MIN(nq, k ), a_i, lda, a_r, MIN(nq,
k)+2);
LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 );
info_i = LAPACKE_sormbr( LAPACK_ROW_MAJOR, vect_i, side_i, trans_i, m_i,
n_i, k_i, a_r, lda_r, tau_i, c_r, ldc_r );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc );
failed = compare_sormbr( c, c_i, info, info_i, ldc, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to sormbr\n" );
} else {
printf( "FAILED: row-major high-level interface to sormbr\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( tau != NULL ) {
LAPACKE_free( tau );
}
if( tau_i != NULL ) {
LAPACKE_free( tau_i );
}
if( c != NULL ) {
LAPACKE_free( c );
}
if( c_i != NULL ) {
LAPACKE_free( c_i );
}
if( c_r != NULL ) {
LAPACKE_free( c_r );
}
if( c_save != NULL ) {
LAPACKE_free( c_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
char trans, trans_i;
char diag, diag_i;
lapack_int n, n_i;
lapack_int nrhs, nrhs_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int ldb, ldb_i;
lapack_int ldb_r;
lapack_int ldx, ldx_i;
lapack_int ldx_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *b = NULL, *b_i = NULL;
lapack_complex_double *x = NULL, *x_i = NULL;
double *ferr = NULL, *ferr_i = NULL;
double *berr = NULL, *berr_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
double *rwork = NULL, *rwork_i = NULL;
double *ferr_save = NULL;
double *berr_save = NULL;
lapack_complex_double *a_r = NULL;
lapack_complex_double *b_r = NULL;
lapack_complex_double *x_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_ztrrfs( &uplo, &trans, &diag, &n, &nrhs, &lda, &ldb, &ldx );
lda_r = n+2;
ldb_r = nrhs+2;
ldx_r = nrhs+2;
uplo_i = uplo;
trans_i = trans;
diag_i = diag;
n_i = n;
nrhs_i = nrhs;
lda_i = lda;
ldb_i = ldb;
ldx_i = ldx;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
b = (lapack_complex_double *)
LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_double) );
x = (lapack_complex_double *)
LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_double) );
ferr = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
berr = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
work = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
b_i = (lapack_complex_double *)
LAPACKE_malloc( ldb*nrhs * sizeof(lapack_complex_double) );
x_i = (lapack_complex_double *)
LAPACKE_malloc( ldx*nrhs * sizeof(lapack_complex_double) );
ferr_i = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
berr_i = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the backup arrays */
ferr_save = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
berr_save = (double *)LAPACKE_malloc( nrhs * sizeof(double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
b_r = (lapack_complex_double *)
LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_double) );
x_r = (lapack_complex_double *)
LAPACKE_malloc( n*(nrhs+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_b( ldb*nrhs, b );
init_x( ldx*nrhs, x );
init_ferr( nrhs, ferr );
init_berr( nrhs, berr );
init_work( 2*n, work );
init_rwork( n, rwork );
/* Backup the ouptut arrays */
for( i = 0; i < nrhs; i++ ) {
ferr_save[i] = ferr[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_save[i] = berr[i];
}
/* Call the LAPACK routine */
ztrrfs_( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, x, &ldx, ferr,
berr, work, rwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_ztrrfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, a_i, lda_i, b_i, ldb_i, x_i,
ldx_i, ferr_i, berr_i, work_i, rwork_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to ztrrfs\n" );
} else {
printf( "FAILED: column-major middle-level interface to ztrrfs\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_ztrrfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, a_i, lda_i, b_i, ldb_i, x_i, ldx_i, ferr_i,
berr_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to ztrrfs\n" );
} else {
printf( "FAILED: column-major high-level interface to ztrrfs\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_ztrrfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i,
n_i, nrhs_i, a_r, lda_r, b_r, ldb_r, x_r,
ldx_r, ferr_i, berr_i, work_i, rwork_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to ztrrfs\n" );
} else {
printf( "FAILED: row-major middle-level interface to ztrrfs\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < ldb*nrhs; i++ ) {
b_i[i] = b[i];
}
for( i = 0; i < ldx*nrhs; i++ ) {
x_i[i] = x[i];
}
for( i = 0; i < nrhs; i++ ) {
ferr_i[i] = ferr_save[i];
}
for( i = 0; i < nrhs; i++ ) {
berr_i[i] = berr_save[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 );
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 );
info_i = LAPACKE_ztrrfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i,
nrhs_i, a_r, lda_r, b_r, ldb_r, x_r, ldx_r, ferr_i,
berr_i );
failed = compare_ztrrfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to ztrrfs\n" );
} else {
printf( "FAILED: row-major high-level interface to ztrrfs\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( b != NULL ) {
LAPACKE_free( b );
}
if( b_i != NULL ) {
LAPACKE_free( b_i );
}
if( b_r != NULL ) {
LAPACKE_free( b_r );
}
if( x != NULL ) {
LAPACKE_free( x );
}
if( x_i != NULL ) {
LAPACKE_free( x_i );
}
if( x_r != NULL ) {
LAPACKE_free( x_r );
}
if( ferr != NULL ) {
LAPACKE_free( ferr );
}
if( ferr_i != NULL ) {
LAPACKE_free( ferr_i );
}
if( ferr_save != NULL ) {
LAPACKE_free( ferr_save );
}
if( berr != NULL ) {
LAPACKE_free( berr );
}
if( berr_i != NULL ) {
LAPACKE_free( berr_i );
}
if( berr_save != NULL ) {
LAPACKE_free( berr_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( rwork != NULL ) {
LAPACKE_free( rwork );
}
if( rwork_i != NULL ) {
LAPACKE_free( rwork_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char job, job_i;
char eigsrc, eigsrc_i;
char initv, initv_i;
lapack_int n, n_i;
lapack_int ldh, ldh_i;
lapack_int ldh_r;
lapack_int ldvl, ldvl_i;
lapack_int ldvl_r;
lapack_int ldvr, ldvr_i;
lapack_int ldvr_r;
lapack_int mm, mm_i;
lapack_int m, m_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_int *select = NULL, *select_i = NULL;
lapack_complex_double *h = NULL, *h_i = NULL;
lapack_complex_double *w = NULL, *w_i = NULL;
lapack_complex_double *vl = NULL, *vl_i = NULL;
lapack_complex_double *vr = NULL, *vr_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
double *rwork = NULL, *rwork_i = NULL;
lapack_int *ifaill = NULL, *ifaill_i = NULL;
lapack_int *ifailr = NULL, *ifailr_i = NULL;
lapack_complex_double *w_save = NULL;
lapack_complex_double *vl_save = NULL;
lapack_complex_double *vr_save = NULL;
lapack_int *ifaill_save = NULL;
lapack_int *ifailr_save = NULL;
lapack_complex_double *h_r = NULL;
lapack_complex_double *vl_r = NULL;
lapack_complex_double *vr_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zhsein( &job, &eigsrc, &initv, &n, &ldh, &ldvl, &ldvr, &mm );
ldh_r = n+2;
ldvl_r = mm+2;
ldvr_r = mm+2;
job_i = job;
eigsrc_i = eigsrc;
initv_i = initv;
n_i = n;
ldh_i = ldh;
ldvl_i = ldvl;
ldvr_i = ldvr;
mm_i = mm;
/* Allocate memory for the LAPACK routine arrays */
select = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
h = (lapack_complex_double *)
LAPACKE_malloc( ldh*n * sizeof(lapack_complex_double) );
w = (lapack_complex_double *)
LAPACKE_malloc( n * sizeof(lapack_complex_double) );
vl = (lapack_complex_double *)
LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
vr = (lapack_complex_double *)
LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( n*n * sizeof(lapack_complex_double) );
rwork = (double *)LAPACKE_malloc( n * sizeof(double) );
ifaill = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
ifailr = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
/* Allocate memory for the C interface function arrays */
select_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
h_i = (lapack_complex_double *)
LAPACKE_malloc( ldh*n * sizeof(lapack_complex_double) );
w_i = (lapack_complex_double *)
LAPACKE_malloc( n * sizeof(lapack_complex_double) );
vl_i = (lapack_complex_double *)
LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
vr_i = (lapack_complex_double *)
LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( n*n * sizeof(lapack_complex_double) );
rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) );
ifaill_i = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
ifailr_i = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
/* Allocate memory for the backup arrays */
w_save = (lapack_complex_double *)
LAPACKE_malloc( n * sizeof(lapack_complex_double) );
vl_save = (lapack_complex_double *)
LAPACKE_malloc( ldvl*mm * sizeof(lapack_complex_double) );
vr_save = (lapack_complex_double *)
LAPACKE_malloc( ldvr*mm * sizeof(lapack_complex_double) );
ifaill_save = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
ifailr_save = (lapack_int *)LAPACKE_malloc( mm * sizeof(lapack_int) );
/* Allocate memory for the row-major arrays */
h_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
vl_r = (lapack_complex_double *)
LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_double) );
vr_r = (lapack_complex_double *)
LAPACKE_malloc( n*(mm+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_select( n, select );
init_h( ldh*n, h );
init_w( n, w );
init_vl( ldvl*mm, vl );
init_vr( ldvr*mm, vr );
init_work( n*n, work );
init_rwork( n, rwork );
init_ifaill( mm, ifaill );
init_ifailr( mm, ifailr );
/* Backup the ouptut arrays */
for( i = 0; i < n; i++ ) {
w_save[i] = w[i];
}
for( i = 0; i < ldvl*mm; i++ ) {
vl_save[i] = vl[i];
}
for( i = 0; i < ldvr*mm; i++ ) {
vr_save[i] = vr[i];
}
for( i = 0; i < mm; i++ ) {
ifaill_save[i] = ifaill[i];
}
for( i = 0; i < mm; i++ ) {
ifailr_save[i] = ifailr[i];
}
/* Call the LAPACK routine */
zhsein_( &job, &eigsrc, &initv, select, &n, h, &ldh, w, vl, &ldvl, vr,
&ldvr, &mm, &m, work, rwork, ifaill, ifailr, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
select_i[i] = select[i];
}
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldvl*mm; i++ ) {
vl_i[i] = vl_save[i];
}
for( i = 0; i < ldvr*mm; i++ ) {
vr_i[i] = vr_save[i];
}
for( i = 0; i < n*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
for( i = 0; i < mm; i++ ) {
ifaill_i[i] = ifaill_save[i];
}
for( i = 0; i < mm; i++ ) {
ifailr_i[i] = ifailr_save[i];
}
info_i = LAPACKE_zhsein_work( LAPACK_COL_MAJOR, job_i, eigsrc_i, initv_i,
select_i, n_i, h_i, ldh_i, w_i, vl_i, ldvl_i,
vr_i, ldvr_i, mm_i, &m_i, work_i, rwork_i,
ifaill_i, ifailr_i );
failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
ifaill_i, ifailr, ifailr_i, info, info_i, job,
ldvl, ldvr, mm, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zhsein\n" );
} else {
printf( "FAILED: column-major middle-level interface to zhsein\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
select_i[i] = select[i];
}
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldvl*mm; i++ ) {
vl_i[i] = vl_save[i];
}
for( i = 0; i < ldvr*mm; i++ ) {
vr_i[i] = vr_save[i];
}
for( i = 0; i < n*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
for( i = 0; i < mm; i++ ) {
ifaill_i[i] = ifaill_save[i];
}
for( i = 0; i < mm; i++ ) {
ifailr_i[i] = ifailr_save[i];
}
info_i = LAPACKE_zhsein( LAPACK_COL_MAJOR, job_i, eigsrc_i, initv_i,
select_i, n_i, h_i, ldh_i, w_i, vl_i, ldvl_i, vr_i,
ldvr_i, mm_i, &m_i, ifaill_i, ifailr_i );
failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
ifaill_i, ifailr, ifailr_i, info, info_i, job,
ldvl, ldvr, mm, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zhsein\n" );
} else {
printf( "FAILED: column-major high-level interface to zhsein\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
select_i[i] = select[i];
}
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldvl*mm; i++ ) {
vl_i[i] = vl_save[i];
}
for( i = 0; i < ldvr*mm; i++ ) {
vr_i[i] = vr_save[i];
}
for( i = 0; i < n*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
for( i = 0; i < mm; i++ ) {
ifaill_i[i] = ifaill_save[i];
}
for( i = 0; i < mm; i++ ) {
ifailr_i[i] = ifailr_save[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
}
info_i = LAPACKE_zhsein_work( LAPACK_ROW_MAJOR, job_i, eigsrc_i, initv_i,
select_i, n_i, h_r, ldh_r, w_i, vl_r, ldvl_r,
vr_r, ldvr_r, mm_i, &m_i, work_i, rwork_i,
ifaill_i, ifailr_i );
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
}
failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
ifaill_i, ifailr, ifailr_i, info, info_i, job,
ldvl, ldvr, mm, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zhsein\n" );
} else {
printf( "FAILED: row-major middle-level interface to zhsein\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
select_i[i] = select[i];
}
for( i = 0; i < ldh*n; i++ ) {
h_i[i] = h[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < ldvl*mm; i++ ) {
vl_i[i] = vl_save[i];
}
for( i = 0; i < ldvr*mm; i++ ) {
vr_i[i] = vr_save[i];
}
for( i = 0; i < n*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
for( i = 0; i < mm; i++ ) {
ifaill_i[i] = ifaill_save[i];
}
for( i = 0; i < mm; i++ ) {
ifailr_i[i] = ifailr_save[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 );
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vl_i, ldvl, vl_r, mm+2 );
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, mm, vr_i, ldvr, vr_r, mm+2 );
}
info_i = LAPACKE_zhsein( LAPACK_ROW_MAJOR, job_i, eigsrc_i, initv_i,
select_i, n_i, h_r, ldh_r, w_i, vl_r, ldvl_r, vr_r,
ldvr_r, mm_i, &m_i, ifaill_i, ifailr_i );
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'l' ) ) {
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vl_r, mm+2, vl_i, ldvl );
}
if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'r' ) ) {
LAPACKE_zge_trans( LAPACK_ROW_MAJOR, n, mm, vr_r, mm+2, vr_i, ldvr );
}
failed = compare_zhsein( w, w_i, vl, vl_i, vr, vr_i, m, m_i, ifaill,
ifaill_i, ifailr, ifailr_i, info, info_i, job,
ldvl, ldvr, mm, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zhsein\n" );
} else {
printf( "FAILED: row-major high-level interface to zhsein\n" );
}
/* Release memory */
if( select != NULL ) {
LAPACKE_free( select );
}
if( select_i != NULL ) {
LAPACKE_free( select_i );
}
if( h != NULL ) {
LAPACKE_free( h );
}
if( h_i != NULL ) {
LAPACKE_free( h_i );
}
if( h_r != NULL ) {
LAPACKE_free( h_r );
}
if( w != NULL ) {
LAPACKE_free( w );
}
if( w_i != NULL ) {
LAPACKE_free( w_i );
}
if( w_save != NULL ) {
LAPACKE_free( w_save );
}
if( vl != NULL ) {
LAPACKE_free( vl );
}
if( vl_i != NULL ) {
LAPACKE_free( vl_i );
}
if( vl_r != NULL ) {
LAPACKE_free( vl_r );
}
if( vl_save != NULL ) {
LAPACKE_free( vl_save );
}
if( vr != NULL ) {
LAPACKE_free( vr );
}
if( vr_i != NULL ) {
LAPACKE_free( vr_i );
}
if( vr_r != NULL ) {
LAPACKE_free( vr_r );
}
if( vr_save != NULL ) {
LAPACKE_free( vr_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( rwork != NULL ) {
LAPACKE_free( rwork );
}
if( rwork_i != NULL ) {
LAPACKE_free( rwork_i );
}
if( ifaill != NULL ) {
LAPACKE_free( ifaill );
}
if( ifaill_i != NULL ) {
LAPACKE_free( ifaill_i );
}
if( ifaill_save != NULL ) {
LAPACKE_free( ifaill_save );
}
if( ifailr != NULL ) {
LAPACKE_free( ifailr );
}
if( ifailr_i != NULL ) {
LAPACKE_free( ifailr_i );
}
if( ifailr_save != NULL ) {
LAPACKE_free( ifailr_save );
}
return 0;
}
int main(void)
{
/* Local scalars */
char range, range_i;
char order, order_i;
lapack_int n, n_i;
double vl, vl_i;
double vu, vu_i;
lapack_int il, il_i;
lapack_int iu, iu_i;
double abstol, abstol_i;
lapack_int m, m_i;
lapack_int nsplit, nsplit_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
double *d = NULL, *d_i = NULL;
double *e = NULL, *e_i = NULL;
double *w = NULL, *w_i = NULL;
lapack_int *iblock = NULL, *iblock_i = NULL;
lapack_int *isplit = NULL, *isplit_i = NULL;
double *work = NULL, *work_i = NULL;
lapack_int *iwork = NULL, *iwork_i = NULL;
double *w_save = NULL;
lapack_int *iblock_save = NULL;
lapack_int *isplit_save = NULL;
/* Iniitialize the scalar parameters */
init_scalars_dstebz( &range, &order, &n, &vl, &vu, &il, &iu, &abstol );
range_i = range;
order_i = order;
n_i = n;
vl_i = vl;
vu_i = vu;
il_i = il;
iu_i = iu;
abstol_i = abstol;
/* Allocate memory for the LAPACK routine arrays */
d = (double *)LAPACKE_malloc( n * sizeof(double) );
e = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
w = (double *)LAPACKE_malloc( n * sizeof(double) );
iblock = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
isplit = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work = (double *)LAPACKE_malloc( 4*n * sizeof(double) );
iwork = (lapack_int *)LAPACKE_malloc( 3*n * sizeof(lapack_int) );
/* Allocate memory for the C interface function arrays */
d_i = (double *)LAPACKE_malloc( n * sizeof(double) );
e_i = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
w_i = (double *)LAPACKE_malloc( n * sizeof(double) );
iblock_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
isplit_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work_i = (double *)LAPACKE_malloc( 4*n * sizeof(double) );
iwork_i = (lapack_int *)LAPACKE_malloc( 3*n * sizeof(lapack_int) );
/* Allocate memory for the backup arrays */
w_save = (double *)LAPACKE_malloc( n * sizeof(double) );
iblock_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
isplit_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the row-major arrays */
/* Initialize input arrays */
init_d( n, d );
init_e( (n-1), e );
init_w( n, w );
init_iblock( n, iblock );
init_isplit( n, isplit );
init_work( 4*n, work );
init_iwork( 3*n, iwork );
/* Backup the ouptut arrays */
for( i = 0; i < n; i++ ) {
w_save[i] = w[i];
}
for( i = 0; i < n; i++ ) {
iblock_save[i] = iblock[i];
}
for( i = 0; i < n; i++ ) {
isplit_save[i] = isplit[i];
}
/* Call the LAPACK routine */
dstebz_( &range, &order, &n, &vl, &vu, &il, &iu, &abstol, d, e, &m, &nsplit,
w, iblock, isplit, work, iwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < n; i++ ) {
iblock_i[i] = iblock_save[i];
}
for( i = 0; i < n; i++ ) {
isplit_i[i] = isplit_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < 3*n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_dstebz_work( range_i, order_i, n_i, vl_i, vu_i, il_i, iu_i,
abstol_i, d_i, e_i, &m_i, &nsplit_i, w_i,
iblock_i, isplit_i, work_i, iwork_i );
failed = compare_dstebz( m, m_i, nsplit, nsplit_i, w, w_i, iblock, iblock_i,
isplit, isplit_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to dstebz\n" );
} else {
printf( "FAILED: column-major middle-level interface to dstebz\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e[i];
}
for( i = 0; i < n; i++ ) {
w_i[i] = w_save[i];
}
for( i = 0; i < n; i++ ) {
iblock_i[i] = iblock_save[i];
}
for( i = 0; i < n; i++ ) {
isplit_i[i] = isplit_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < 3*n; i++ ) {
iwork_i[i] = iwork[i];
}
info_i = LAPACKE_dstebz( range_i, order_i, n_i, vl_i, vu_i, il_i, iu_i,
abstol_i, d_i, e_i, &m_i, &nsplit_i, w_i, iblock_i,
isplit_i );
failed = compare_dstebz( m, m_i, nsplit, nsplit_i, w, w_i, iblock, iblock_i,
isplit, isplit_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to dstebz\n" );
} else {
printf( "FAILED: column-major high-level interface to dstebz\n" );
}
failed = compare_dstebz( m, m_i, nsplit, nsplit_i, w, w_i, iblock, iblock_i,
isplit, isplit_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to dstebz\n" );
} else {
printf( "FAILED: row-major middle-level interface to dstebz\n" );
}
failed = compare_dstebz( m, m_i, nsplit, nsplit_i, w, w_i, iblock, iblock_i,
isplit, isplit_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to dstebz\n" );
} else {
printf( "FAILED: row-major high-level interface to dstebz\n" );
}
/* Release memory */
if( d != NULL ) {
LAPACKE_free( d );
}
if( d_i != NULL ) {
LAPACKE_free( d_i );
}
if( e != NULL ) {
LAPACKE_free( e );
}
if( e_i != NULL ) {
LAPACKE_free( e_i );
}
if( w != NULL ) {
LAPACKE_free( w );
}
if( w_i != NULL ) {
LAPACKE_free( w_i );
}
if( w_save != NULL ) {
LAPACKE_free( w_save );
}
if( iblock != NULL ) {
LAPACKE_free( iblock );
}
if( iblock_i != NULL ) {
LAPACKE_free( iblock_i );
}
if( iblock_save != NULL ) {
LAPACKE_free( iblock_save );
}
if( isplit != NULL ) {
LAPACKE_free( isplit );
}
if( isplit_i != NULL ) {
LAPACKE_free( isplit_i );
}
if( isplit_save != NULL ) {
LAPACKE_free( isplit_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( iwork != NULL ) {
LAPACKE_free( iwork );
}
if( iwork_i != NULL ) {
LAPACKE_free( iwork_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int ncvt, ncvt_i;
lapack_int nru, nru_i;
lapack_int ncc, ncc_i;
lapack_int ldvt, ldvt_i;
lapack_int ldvt_r;
lapack_int ldu, ldu_i;
lapack_int ldu_r;
lapack_int ldc, ldc_i;
lapack_int ldc_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *d = NULL, *d_i = NULL;
float *e = NULL, *e_i = NULL;
lapack_complex_float *vt = NULL, *vt_i = NULL;
lapack_complex_float *u = NULL, *u_i = NULL;
lapack_complex_float *c = NULL, *c_i = NULL;
float *work = NULL, *work_i = NULL;
float *d_save = NULL;
float *e_save = NULL;
lapack_complex_float *vt_save = NULL;
lapack_complex_float *u_save = NULL;
lapack_complex_float *c_save = NULL;
lapack_complex_float *vt_r = NULL;
lapack_complex_float *u_r = NULL;
lapack_complex_float *c_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_cbdsqr( &uplo, &n, &ncvt, &nru, &ncc, &ldvt, &ldu, &ldc );
ldvt_r = ncvt+2;
ldu_r = n+2;
ldc_r = ncc+2;
uplo_i = uplo;
n_i = n;
ncvt_i = ncvt;
nru_i = nru;
ncc_i = ncc;
ldvt_i = ldvt;
ldu_i = ldu;
ldc_i = ldc;
/* Allocate memory for the LAPACK routine arrays */
d = (float *)LAPACKE_malloc( n * sizeof(float) );
e = (float *)LAPACKE_malloc( n * sizeof(float) );
vt = (lapack_complex_float *)
LAPACKE_malloc( ldvt*ncvt * sizeof(lapack_complex_float) );
u = (lapack_complex_float *)
LAPACKE_malloc( ldu*n * sizeof(lapack_complex_float) );
c = (lapack_complex_float *)
LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_float) );
work = (float *)LAPACKE_malloc( 4*n * sizeof(float) );
/* Allocate memory for the C interface function arrays */
d_i = (float *)LAPACKE_malloc( n * sizeof(float) );
e_i = (float *)LAPACKE_malloc( n * sizeof(float) );
vt_i = (lapack_complex_float *)
LAPACKE_malloc( ldvt*ncvt * sizeof(lapack_complex_float) );
u_i = (lapack_complex_float *)
LAPACKE_malloc( ldu*n * sizeof(lapack_complex_float) );
c_i = (lapack_complex_float *)
LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_float) );
work_i = (float *)LAPACKE_malloc( 4*n * sizeof(float) );
/* Allocate memory for the backup arrays */
d_save = (float *)LAPACKE_malloc( n * sizeof(float) );
e_save = (float *)LAPACKE_malloc( n * sizeof(float) );
vt_save = (lapack_complex_float *)
LAPACKE_malloc( ldvt*ncvt * sizeof(lapack_complex_float) );
u_save = (lapack_complex_float *)
LAPACKE_malloc( ldu*n * sizeof(lapack_complex_float) );
c_save = (lapack_complex_float *)
LAPACKE_malloc( ldc*ncc * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
vt_r = (lapack_complex_float *)
LAPACKE_malloc( n*(ncvt+2) * sizeof(lapack_complex_float) );
u_r = (lapack_complex_float *)
LAPACKE_malloc( nru*(n+2) * sizeof(lapack_complex_float) );
c_r = (lapack_complex_float *)
LAPACKE_malloc( n*(ncc+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_d( n, d );
init_e( n, e );
init_vt( ldvt*ncvt, vt );
init_u( ldu*n, u );
init_c( ldc*ncc, c );
init_work( 4*n, work );
/* Backup the ouptut arrays */
for( i = 0; i < n; i++ ) {
d_save[i] = d[i];
}
for( i = 0; i < n; i++ ) {
e_save[i] = e[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_save[i] = vt[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_save[i] = u[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_save[i] = c[i];
}
/* Call the LAPACK routine */
cbdsqr_( &uplo, &n, &ncvt, &nru, &ncc, d, e, vt, &ldvt, u, &ldu, c, &ldc,
work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cbdsqr_work( LAPACK_COL_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_i, ldvt_i, u_i, ldu_i,
c_i, ldc_i, work_i );
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to cbdsqr\n" );
} else {
printf( "FAILED: column-major middle-level interface to cbdsqr\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_cbdsqr( LAPACK_COL_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_i, ldvt_i, u_i, ldu_i, c_i,
ldc_i );
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to cbdsqr\n" );
} else {
printf( "FAILED: column-major high-level interface to cbdsqr\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_i, ldvt, vt_r,
ncvt+2 );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nru, n, u_i, ldu, u_r, n+2 );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncc, c_i, ldc, c_r, ncc+2 );
}
info_i = LAPACKE_cbdsqr_work( LAPACK_ROW_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_r, ldvt_r, u_r, ldu_r,
c_r, ldc_r, work_i );
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncvt, vt_r, ncvt+2, vt_i,
ldvt );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nru, n, u_r, n+2, u_i, ldu );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncc, c_r, ncc+2, c_i, ldc );
}
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to cbdsqr\n" );
} else {
printf( "FAILED: row-major middle-level interface to cbdsqr\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < n; i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldvt*ncvt; i++ ) {
vt_i[i] = vt_save[i];
}
for( i = 0; i < ldu*n; i++ ) {
u_i[i] = u_save[i];
}
for( i = 0; i < ldc*ncc; i++ ) {
c_i[i] = c_save[i];
}
for( i = 0; i < 4*n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncvt, vt_i, ldvt, vt_r,
ncvt+2 );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, nru, n, u_i, ldu, u_r, n+2 );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, ncc, c_i, ldc, c_r, ncc+2 );
}
info_i = LAPACKE_cbdsqr( LAPACK_ROW_MAJOR, uplo_i, n_i, ncvt_i, nru_i,
ncc_i, d_i, e_i, vt_r, ldvt_r, u_r, ldu_r, c_r,
ldc_r );
if( ncvt != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncvt, vt_r, ncvt+2, vt_i,
ldvt );
}
if( nru != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, nru, n, u_r, n+2, u_i, ldu );
}
if( ncc != 0 ) {
LAPACKE_cge_trans( LAPACK_ROW_MAJOR, n, ncc, c_r, ncc+2, c_i, ldc );
}
failed = compare_cbdsqr( d, d_i, e, e_i, vt, vt_i, u, u_i, c, c_i, info,
info_i, ldc, ldu, ldvt, n, ncc, ncvt, nru );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to cbdsqr\n" );
} else {
printf( "FAILED: row-major high-level interface to cbdsqr\n" );
}
/* Release memory */
if( d != NULL ) {
LAPACKE_free( d );
}
if( d_i != NULL ) {
LAPACKE_free( d_i );
}
if( d_save != NULL ) {
LAPACKE_free( d_save );
}
if( e != NULL ) {
LAPACKE_free( e );
}
if( e_i != NULL ) {
LAPACKE_free( e_i );
}
if( e_save != NULL ) {
LAPACKE_free( e_save );
}
if( vt != NULL ) {
LAPACKE_free( vt );
}
if( vt_i != NULL ) {
LAPACKE_free( vt_i );
}
if( vt_r != NULL ) {
LAPACKE_free( vt_r );
}
if( vt_save != NULL ) {
LAPACKE_free( vt_save );
}
if( u != NULL ) {
LAPACKE_free( u );
}
if( u_i != NULL ) {
LAPACKE_free( u_i );
}
if( u_r != NULL ) {
LAPACKE_free( u_r );
}
if( u_save != NULL ) {
LAPACKE_free( u_save );
}
if( c != NULL ) {
LAPACKE_free( c );
}
if( c_i != NULL ) {
LAPACKE_free( c_i );
}
if( c_r != NULL ) {
LAPACKE_free( c_r );
}
if( c_save != NULL ) {
LAPACKE_free( c_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char compq, compq_i;
lapack_int n, n_i;
lapack_int ldt, ldt_i;
lapack_int ldt_r;
lapack_int ldq, ldq_i;
lapack_int ldq_r;
lapack_int ifst, ifst_i, ifst_save;
lapack_int ilst, ilst_i, ilst_save;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
double *t = NULL, *t_i = NULL;
double *q = NULL, *q_i = NULL;
double *work = NULL, *work_i = NULL;
double *t_save = NULL;
double *q_save = NULL;
double *t_r = NULL;
double *q_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_dtrexc( &compq, &n, &ldt, &ldq, &ifst, &ilst );
ldt_r = n+2;
ldq_r = n+2;
compq_i = compq;
n_i = n;
ldt_i = ldt;
ldq_i = ldq;
ifst_i = ifst_save = ifst;
ilst_i = ilst_save = ilst;
/* Allocate memory for the LAPACK routine arrays */
t = (double *)LAPACKE_malloc( ldt*n * sizeof(double) );
q = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
work = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the C interface function arrays */
t_i = (double *)LAPACKE_malloc( ldt*n * sizeof(double) );
q_i = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
work_i = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the backup arrays */
t_save = (double *)LAPACKE_malloc( ldt*n * sizeof(double) );
q_save = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
/* Allocate memory for the row-major arrays */
t_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
q_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
/* Initialize input arrays */
init_t( ldt*n, t );
init_q( ldq*n, q );
init_work( n, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldt*n; i++ ) {
t_save[i] = t[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_save[i] = q[i];
}
/* Call the LAPACK routine */
dtrexc_( &compq, &n, t, &ldt, q, &ldq, &ifst, &ilst, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
ifst_i = ifst_save;
ilst_i = ilst_save;
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_dtrexc_work( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i,
q_i, ldq_i, &ifst_i, &ilst_i, work_i );
failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to dtrexc\n" );
} else {
printf( "FAILED: column-major middle-level interface to dtrexc\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
ifst_i = ifst_save;
ilst_i = ilst_save;
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_dtrexc( LAPACK_COL_MAJOR, compq_i, n_i, t_i, ldt_i, q_i,
ldq_i, &ifst_i, &ilst_i );
failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to dtrexc\n" );
} else {
printf( "FAILED: column-major high-level interface to dtrexc\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
ifst_i = ifst_save;
ilst_i = ilst_save;
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
}
info_i = LAPACKE_dtrexc_work( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r,
q_r, ldq_r, &ifst_i, &ilst_i, work_i );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
}
failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to dtrexc\n" );
} else {
printf( "FAILED: row-major middle-level interface to dtrexc\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
ifst_i = ifst_save;
ilst_i = ilst_save;
for( i = 0; i < ldt*n; i++ ) {
t_i[i] = t_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_i, ldt, t_r, n+2 );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
}
info_i = LAPACKE_dtrexc( LAPACK_ROW_MAJOR, compq_i, n_i, t_r, ldt_r, q_r,
ldq_r, &ifst_i, &ilst_i );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, t_r, n+2, t_i, ldt );
if( LAPACKE_lsame( compq, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
}
failed = compare_dtrexc( t, t_i, q, q_i, ifst, ifst_i, ilst, ilst_i, info,
info_i, compq, ldq, ldt, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to dtrexc\n" );
} else {
printf( "FAILED: row-major high-level interface to dtrexc\n" );
}
/* Release memory */
if( t != NULL ) {
LAPACKE_free( t );
}
if( t_i != NULL ) {
LAPACKE_free( t_i );
}
if( t_r != NULL ) {
LAPACKE_free( t_r );
}
if( t_save != NULL ) {
LAPACKE_free( t_save );
}
if( q != NULL ) {
LAPACKE_free( q );
}
if( q_i != NULL ) {
LAPACKE_free( q_i );
}
if( q_r != NULL ) {
LAPACKE_free( q_r );
}
if( q_save != NULL ) {
LAPACKE_free( q_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_float *ap = NULL, *ap_i = NULL;
lapack_int *ipiv = NULL, *ipiv_i = NULL;
lapack_complex_float *work = NULL, *work_i = NULL;
lapack_complex_float *ap_save = NULL;
lapack_complex_float *ap_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_csptri( &uplo, &n );
uplo_i = uplo;
n_i = n;
/* Allocate memory for the LAPACK routine arrays */
ap = (lapack_complex_float *)
LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) );
ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work = (lapack_complex_float *)
LAPACKE_malloc( n * sizeof(lapack_complex_float) );
/* Allocate memory for the C interface function arrays */
ap_i = (lapack_complex_float *)
LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) );
ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work_i = (lapack_complex_float *)
LAPACKE_malloc( n * sizeof(lapack_complex_float) );
/* Allocate memory for the backup arrays */
ap_save = (lapack_complex_float *)
LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(lapack_complex_float) );
/* Allocate memory for the row-major arrays */
ap_r = (lapack_complex_float *)
LAPACKE_malloc( n*(n+1)/2 * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_ap( (n*(n+1)/2), ap );
init_ipiv( n, ipiv );
init_work( n, work );
/* Backup the ouptut arrays */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_save[i] = ap[i];
}
/* Call the LAPACK routine */
csptri_( &uplo, &n, ap, ipiv, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_csptri_work( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i, ipiv_i,
work_i );
failed = compare_csptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to csptri\n" );
} else {
printf( "FAILED: column-major middle-level interface to csptri\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_csptri( LAPACK_COL_MAJOR, uplo_i, n_i, ap_i, ipiv_i );
failed = compare_csptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to csptri\n" );
} else {
printf( "FAILED: column-major high-level interface to csptri\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
info_i = LAPACKE_csptri_work( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r, ipiv_i,
work_i );
LAPACKE_cpp_trans( LAPACK_ROW_MAJOR, uplo, n, ap_r, ap_i );
failed = compare_csptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to csptri\n" );
} else {
printf( "FAILED: row-major middle-level interface to csptri\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < (n*(n+1)/2); i++ ) {
ap_i[i] = ap_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_cpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r );
info_i = LAPACKE_csptri( LAPACK_ROW_MAJOR, uplo_i, n_i, ap_r, ipiv_i );
LAPACKE_cpp_trans( LAPACK_ROW_MAJOR, uplo, n, ap_r, ap_i );
failed = compare_csptri( ap, ap_i, info, info_i, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to csptri\n" );
} else {
printf( "FAILED: row-major high-level interface to csptri\n" );
}
/* Release memory */
if( ap != NULL ) {
LAPACKE_free( ap );
}
if( ap_i != NULL ) {
LAPACKE_free( ap_i );
}
if( ap_r != NULL ) {
LAPACKE_free( ap_r );
}
if( ap_save != NULL ) {
LAPACKE_free( ap_save );
}
if( ipiv != NULL ) {
LAPACKE_free( ipiv );
}
if( ipiv_i != NULL ) {
LAPACKE_free( ipiv_i );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
lapack_int lwork, lwork_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
lapack_int *ipiv = NULL, *ipiv_i = NULL;
float *work = NULL, *work_i = NULL;
float *a_save = NULL;
lapack_int *ipiv_save = NULL;
float *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_ssytrf( &uplo, &n, &lda, &lwork );
lda_r = n+2;
uplo_i = uplo;
n_i = n;
lda_i = lda;
lwork_i = lwork;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) );
/* Allocate memory for the backup arrays */
a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
ipiv_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) );
/* Allocate memory for the row-major arrays */
a_r = (float *)LAPACKE_malloc( n*(n+2) * sizeof(float) );
/* Initialize input arrays */
init_a( lda*n, a );
init_ipiv( n, ipiv );
init_work( lwork, work );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
for( i = 0; i < n; i++ ) {
ipiv_save[i] = ipiv[i];
}
/* Call the LAPACK routine */
ssytrf_( &uplo, &n, a, &lda, ipiv, work, &lwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_ssytrf_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
ipiv_i, work_i, lwork_i );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to ssytrf\n" );
} else {
printf( "FAILED: column-major middle-level interface to ssytrf\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_ssytrf( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
ipiv_i );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to ssytrf\n" );
} else {
printf( "FAILED: column-major high-level interface to ssytrf\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_ssytrf_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
ipiv_i, work_i, lwork_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to ssytrf\n" );
} else {
printf( "FAILED: row-major middle-level interface to ssytrf\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a_save[i];
}
for( i = 0; i < n; i++ ) {
ipiv_i[i] = ipiv_save[i];
}
for( i = 0; i < lwork; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_ssytrf( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
ipiv_i );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to ssytrf\n" );
} else {
printf( "FAILED: row-major high-level interface to ssytrf\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( a_save != NULL ) {
LAPACKE_free( a_save );
}
if( ipiv != NULL ) {
LAPACKE_free( ipiv );
}
if( ipiv_i != NULL ) {
LAPACKE_free( ipiv_i );
}
if( ipiv_save != NULL ) {
LAPACKE_free( ipiv_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int lda, lda_i;
lapack_int lda_r;
double anorm, anorm_i;
double rcond, rcond_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_double *a = NULL, *a_i = NULL;
lapack_complex_double *work = NULL, *work_i = NULL;
double *rwork = NULL, *rwork_i = NULL;
lapack_complex_double *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_zpocon( &uplo, &n, &lda, &anorm );
lda_r = n+2;
uplo_i = uplo;
n_i = n;
lda_i = lda;
anorm_i = anorm;
/* Allocate memory for the LAPACK routine arrays */
a = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
work = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the C interface function arrays */
a_i = (lapack_complex_double *)
LAPACKE_malloc( lda*n * sizeof(lapack_complex_double) );
work_i = (lapack_complex_double *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_double) );
rwork_i = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the row-major arrays */
a_r = (lapack_complex_double *)
LAPACKE_malloc( n*(n+2) * sizeof(lapack_complex_double) );
/* Initialize input arrays */
init_a( lda*n, a );
init_work( 2*n, work );
init_rwork( n, rwork );
/* Call the LAPACK routine */
zpocon_( &uplo, &n, a, &lda, &anorm, &rcond, work, rwork, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_zpocon_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i,
anorm_i, &rcond_i, work_i, rwork_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to zpocon\n" );
} else {
printf( "FAILED: column-major middle-level interface to zpocon\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_zpocon( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i, anorm_i,
&rcond_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to zpocon\n" );
} else {
printf( "FAILED: column-major high-level interface to zpocon\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zpocon_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r,
anorm_i, &rcond_i, work_i, rwork_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to zpocon\n" );
} else {
printf( "FAILED: row-major middle-level interface to zpocon\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < lda*n; i++ ) {
a_i[i] = a[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
/* Init row_major arrays */
LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_zpocon( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r, anorm_i,
&rcond_i );
failed = compare_zpocon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to zpocon\n" );
} else {
printf( "FAILED: row-major high-level interface to zpocon\n" );
}
/* Release memory */
if( a != NULL ) {
LAPACKE_free( a );
}
if( a_i != NULL ) {
LAPACKE_free( a_i );
}
if( a_r != NULL ) {
LAPACKE_free( a_r );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( rwork != NULL ) {
LAPACKE_free( rwork );
}
if( rwork_i != NULL ) {
LAPACKE_free( rwork_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char norm, norm_i;
char uplo, uplo_i;
char diag, diag_i;
lapack_int n, n_i;
lapack_int kd, kd_i;
lapack_int ldab, ldab_i;
lapack_int ldab_r;
float rcond, rcond_i;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
lapack_complex_float *ab = NULL, *ab_i = NULL;
lapack_complex_float *work = NULL, *work_i = NULL;
float *rwork = NULL, *rwork_i = NULL;
lapack_complex_float *ab_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_ctbcon( &norm, &uplo, &diag, &n, &kd, &ldab );
ldab_r = n+2;
norm_i = norm;
uplo_i = uplo;
diag_i = diag;
n_i = n;
kd_i = kd;
ldab_i = ldab;
/* Allocate memory for the LAPACK routine arrays */
ab = (lapack_complex_float *)
LAPACKE_malloc( ldab*n * sizeof(lapack_complex_float) );
work = (lapack_complex_float *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_float) );
rwork = (float *)LAPACKE_malloc( n * sizeof(float) );
/* Allocate memory for the C interface function arrays */
ab_i = (lapack_complex_float *)
LAPACKE_malloc( ldab*n * sizeof(lapack_complex_float) );
work_i = (lapack_complex_float *)
LAPACKE_malloc( 2*n * sizeof(lapack_complex_float) );
rwork_i = (float *)LAPACKE_malloc( n * sizeof(float) );
/* Allocate memory for the row-major arrays */
ab_r = (lapack_complex_float *)
LAPACKE_malloc( (kd+1)*(n+2) * sizeof(lapack_complex_float) );
/* Initialize input arrays */
init_ab( ldab*n, ab );
init_work( 2*n, work );
init_rwork( n, rwork );
/* Call the LAPACK routine */
ctbcon_( &norm, &uplo, &diag, &n, &kd, ab, &ldab, &rcond, work, rwork,
&info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_ctbcon_work( LAPACK_COL_MAJOR, norm_i, uplo_i, diag_i, n_i,
kd_i, ab_i, ldab_i, &rcond_i, work_i,
rwork_i );
failed = compare_ctbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to ctbcon\n" );
} else {
printf( "FAILED: column-major middle-level interface to ctbcon\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
info_i = LAPACKE_ctbcon( LAPACK_COL_MAJOR, norm_i, uplo_i, diag_i, n_i,
kd_i, ab_i, ldab_i, &rcond_i );
failed = compare_ctbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to ctbcon\n" );
} else {
printf( "FAILED: column-major high-level interface to ctbcon\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
LAPACKE_cge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 );
info_i = LAPACKE_ctbcon_work( LAPACK_ROW_MAJOR, norm_i, uplo_i, diag_i, n_i,
kd_i, ab_r, ldab_r, &rcond_i, work_i,
rwork_i );
failed = compare_ctbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to ctbcon\n" );
} else {
printf( "FAILED: row-major middle-level interface to ctbcon\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab[i];
}
for( i = 0; i < 2*n; i++ ) {
work_i[i] = work[i];
}
for( i = 0; i < n; i++ ) {
rwork_i[i] = rwork[i];
}
/* Init row_major arrays */
LAPACKE_cge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 );
info_i = LAPACKE_ctbcon( LAPACK_ROW_MAJOR, norm_i, uplo_i, diag_i, n_i,
kd_i, ab_r, ldab_r, &rcond_i );
failed = compare_ctbcon( rcond, rcond_i, info, info_i );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to ctbcon\n" );
} else {
printf( "FAILED: row-major high-level interface to ctbcon\n" );
}
/* Release memory */
if( ab != NULL ) {
LAPACKE_free( ab );
}
if( ab_i != NULL ) {
LAPACKE_free( ab_i );
}
if( ab_r != NULL ) {
LAPACKE_free( ab_r );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
if( rwork != NULL ) {
LAPACKE_free( rwork );
}
if( rwork_i != NULL ) {
LAPACKE_free( rwork_i );
}
return 0;
}
int main(void)
{
/* Local scalars */
char vect, vect_i;
char uplo, uplo_i;
lapack_int n, n_i;
lapack_int kd, kd_i;
lapack_int ldab, ldab_i;
lapack_int ldab_r;
lapack_int ldq, ldq_i;
lapack_int ldq_r;
lapack_int info, info_i;
lapack_int i;
int failed;
/* Local arrays */
double *ab = NULL, *ab_i = NULL;
double *d = NULL, *d_i = NULL;
double *e = NULL, *e_i = NULL;
double *q = NULL, *q_i = NULL;
double *work = NULL, *work_i = NULL;
double *ab_save = NULL;
double *d_save = NULL;
double *e_save = NULL;
double *q_save = NULL;
double *ab_r = NULL;
double *q_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_dsbtrd( &vect, &uplo, &n, &kd, &ldab, &ldq );
ldab_r = n+2;
ldq_r = n+2;
vect_i = vect;
uplo_i = uplo;
n_i = n;
kd_i = kd;
ldab_i = ldab;
ldq_i = ldq;
/* Allocate memory for the LAPACK routine arrays */
ab = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
d = (double *)LAPACKE_malloc( n * sizeof(double) );
e = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
q = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
work = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the C interface function arrays */
ab_i = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
d_i = (double *)LAPACKE_malloc( n * sizeof(double) );
e_i = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
q_i = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
work_i = (double *)LAPACKE_malloc( n * sizeof(double) );
/* Allocate memory for the backup arrays */
ab_save = (double *)LAPACKE_malloc( ldab*n * sizeof(double) );
d_save = (double *)LAPACKE_malloc( n * sizeof(double) );
e_save = (double *)LAPACKE_malloc( (n-1) * sizeof(double) );
q_save = (double *)LAPACKE_malloc( ldq*n * sizeof(double) );
/* Allocate memory for the row-major arrays */
ab_r = (double *)LAPACKE_malloc( (kd+1)*(n+2) * sizeof(double) );
q_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) );
/* Initialize input arrays */
init_ab( ldab*n, ab );
init_d( n, d );
init_e( (n-1), e );
init_q( ldq*n, q );
init_work( n, work );
/* Backup the ouptut arrays */
for( i = 0; i < ldab*n; i++ ) {
ab_save[i] = ab[i];
}
for( i = 0; i < n; i++ ) {
d_save[i] = d[i];
}
for( i = 0; i < (n-1); i++ ) {
e_save[i] = e[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_save[i] = q[i];
}
/* Call the LAPACK routine */
dsbtrd_( &vect, &uplo, &n, &kd, ab, &ldab, d, e, q, &ldq, work, &info );
/* Initialize input data, call the column-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab_save[i];
}
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_dsbtrd_work( LAPACK_COL_MAJOR, vect_i, uplo_i, n_i, kd_i,
ab_i, ldab_i, d_i, e_i, q_i, ldq_i, work_i );
failed = compare_dsbtrd( ab, ab_i, d, d_i, e, e_i, q, q_i, info, info_i,
ldab, ldq, n, vect );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to dsbtrd\n" );
} else {
printf( "FAILED: column-major middle-level interface to dsbtrd\n" );
}
/* Initialize input data, call the column-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab_save[i];
}
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
info_i = LAPACKE_dsbtrd( LAPACK_COL_MAJOR, vect_i, uplo_i, n_i, kd_i, ab_i,
ldab_i, d_i, e_i, q_i, ldq_i );
failed = compare_dsbtrd( ab, ab_i, d, d_i, e, e_i, q, q_i, info, info_i,
ldab, ldq, n, vect );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to dsbtrd\n" );
} else {
printf( "FAILED: column-major high-level interface to dsbtrd\n" );
}
/* Initialize input data, call the row-major middle-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab_save[i];
}
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
LAPACKE_dge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 );
if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
}
info_i = LAPACKE_dsbtrd_work( LAPACK_ROW_MAJOR, vect_i, uplo_i, n_i, kd_i,
ab_r, ldab_r, d_i, e_i, q_r, ldq_r, work_i );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, kd+1, n, ab_r, n+2, ab_i, ldab );
if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
}
failed = compare_dsbtrd( ab, ab_i, d, d_i, e, e_i, q, q_i, info, info_i,
ldab, ldq, n, vect );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to dsbtrd\n" );
} else {
printf( "FAILED: row-major middle-level interface to dsbtrd\n" );
}
/* Initialize input data, call the row-major high-level
* interface to LAPACK routine and check the results */
for( i = 0; i < ldab*n; i++ ) {
ab_i[i] = ab_save[i];
}
for( i = 0; i < n; i++ ) {
d_i[i] = d_save[i];
}
for( i = 0; i < (n-1); i++ ) {
e_i[i] = e_save[i];
}
for( i = 0; i < ldq*n; i++ ) {
q_i[i] = q_save[i];
}
for( i = 0; i < n; i++ ) {
work_i[i] = work[i];
}
/* Init row_major arrays */
LAPACKE_dge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 );
if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_i, ldq, q_r, n+2 );
}
info_i = LAPACKE_dsbtrd( LAPACK_ROW_MAJOR, vect_i, uplo_i, n_i, kd_i, ab_r,
ldab_r, d_i, e_i, q_r, ldq_r );
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, kd+1, n, ab_r, n+2, ab_i, ldab );
if( LAPACKE_lsame( vect, 'u' ) || LAPACKE_lsame( vect, 'v' ) ) {
LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, q_r, n+2, q_i, ldq );
}
failed = compare_dsbtrd( ab, ab_i, d, d_i, e, e_i, q, q_i, info, info_i,
ldab, ldq, n, vect );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to dsbtrd\n" );
} else {
printf( "FAILED: row-major high-level interface to dsbtrd\n" );
}
/* Release memory */
if( ab != NULL ) {
LAPACKE_free( ab );
}
if( ab_i != NULL ) {
LAPACKE_free( ab_i );
}
if( ab_r != NULL ) {
LAPACKE_free( ab_r );
}
if( ab_save != NULL ) {
LAPACKE_free( ab_save );
}
if( d != NULL ) {
LAPACKE_free( d );
}
if( d_i != NULL ) {
LAPACKE_free( d_i );
}
if( d_save != NULL ) {
LAPACKE_free( d_save );
}
if( e != NULL ) {
LAPACKE_free( e );
}
if( e_i != NULL ) {
LAPACKE_free( e_i );
}
if( e_save != NULL ) {
LAPACKE_free( e_save );
}
if( q != NULL ) {
LAPACKE_free( q );
}
if( q_i != NULL ) {
LAPACKE_free( q_i );
}
if( q_r != NULL ) {
LAPACKE_free( q_r );
}
if( q_save != NULL ) {
LAPACKE_free( q_save );
}
if( work != NULL ) {
LAPACKE_free( work );
}
if( work_i != NULL ) {
LAPACKE_free( work_i );
}
return 0;
}