lapack_int LAPACKE_shseqr( int matrix_order, char job, char compz, lapack_int n, lapack_int ilo, lapack_int ihi, float* h, lapack_int ldh, float* wr, float* wi, float* z, lapack_int ldz ) { lapack_int info = 0; lapack_int lwork = -1; float* work = NULL; float work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_shseqr", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_sge_nancheck( matrix_order, n, n, h, ldh ) ) { return -7; } if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { if( LAPACKE_sge_nancheck( matrix_order, n, n, z, ldz ) ) { return -11; } } #endif /* Query optimal working array(s) size */ info = LAPACKE_shseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, &work_query, lwork ); if( info != 0 ) { goto exit_level_0; } lwork = (lapack_int)work_query; /* Allocate memory for work arrays */ work = (float*)LAPACKE_malloc( sizeof(float) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_shseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh, wr, wi, z, ldz, work, lwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_shseqr", info ); } return info; }
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 */ float *h = NULL, *h_i = NULL; float *wr = NULL, *wr_i = NULL; float *wi = NULL, *wi_i = NULL; float *z = NULL, *z_i = NULL; float *work = NULL, *work_i = NULL; float *h_save = NULL; float *wr_save = NULL; float *wi_save = NULL; float *z_save = NULL; float *h_r = NULL; float *z_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_shseqr( &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 = (float *)LAPACKE_malloc( ldh*n * sizeof(float) ); wr = (float *)LAPACKE_malloc( n * sizeof(float) ); wi = (float *)LAPACKE_malloc( n * sizeof(float) ); z = (float *)LAPACKE_malloc( ldz*n * sizeof(float) ); work = (float *)LAPACKE_malloc( lwork * sizeof(float) ); /* Allocate memory for the C interface function arrays */ h_i = (float *)LAPACKE_malloc( ldh*n * sizeof(float) ); wr_i = (float *)LAPACKE_malloc( n * sizeof(float) ); wi_i = (float *)LAPACKE_malloc( n * sizeof(float) ); z_i = (float *)LAPACKE_malloc( ldz*n * sizeof(float) ); work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) ); /* Allocate memory for the backup arrays */ h_save = (float *)LAPACKE_malloc( ldh*n * sizeof(float) ); wr_save = (float *)LAPACKE_malloc( n * sizeof(float) ); wi_save = (float *)LAPACKE_malloc( n * sizeof(float) ); z_save = (float *)LAPACKE_malloc( ldz*n * sizeof(float) ); /* Allocate memory for the row-major arrays */ h_r = (float *)LAPACKE_malloc( n*(n+2) * sizeof(float) ); z_r = (float *)LAPACKE_malloc( n*(n+2) * sizeof(float) ); /* Initialize input arrays */ init_h( ldh*n, h ); init_wr( n, wr ); init_wi( n, wi ); 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++ ) { wr_save[i] = wr[i]; } for( i = 0; i < n; i++ ) { wi_save[i] = wi[i]; } for( i = 0; i < ldz*n; i++ ) { z_save[i] = z[i]; } /* Call the LAPACK routine */ shseqr_( &job, &compz, &n, &ilo, &ihi, h, &ldh, wr, wi, 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++ ) { wr_i[i] = wr_save[i]; } for( i = 0; i < n; i++ ) { wi_i[i] = wi_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_shseqr_work( LAPACK_COL_MAJOR, job_i, compz_i, n_i, ilo_i, ihi_i, h_i, ldh_i, wr_i, wi_i, z_i, ldz_i, work_i, lwork_i ); failed = compare_shseqr( h, h_i, wr, wr_i, wi, wi_i, z, z_i, info, info_i, compz, ldh, ldz, n ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to shseqr\n" ); } else { printf( "FAILED: column-major middle-level interface to shseqr\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++ ) { wr_i[i] = wr_save[i]; } for( i = 0; i < n; i++ ) { wi_i[i] = wi_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_shseqr( LAPACK_COL_MAJOR, job_i, compz_i, n_i, ilo_i, ihi_i, h_i, ldh_i, wr_i, wi_i, z_i, ldz_i ); failed = compare_shseqr( h, h_i, wr, wr_i, wi, wi_i, z, z_i, info, info_i, compz, ldh, ldz, n ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to shseqr\n" ); } else { printf( "FAILED: column-major high-level interface to shseqr\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++ ) { wr_i[i] = wr_save[i]; } for( i = 0; i < n; i++ ) { wi_i[i] = wi_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_sge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 ); if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 ); } info_i = LAPACKE_shseqr_work( LAPACK_ROW_MAJOR, job_i, compz_i, n_i, ilo_i, ihi_i, h_r, ldh_r, wr_i, wi_i, z_r, ldz_r, work_i, lwork_i ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, h_r, n+2, h_i, ldh ); if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz ); } failed = compare_shseqr( h, h_i, wr, wr_i, wi, wi_i, z, z_i, info, info_i, compz, ldh, ldz, n ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to shseqr\n" ); } else { printf( "FAILED: row-major middle-level interface to shseqr\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++ ) { wr_i[i] = wr_save[i]; } for( i = 0; i < n; i++ ) { wi_i[i] = wi_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_sge_trans( LAPACK_COL_MAJOR, n, n, h_i, ldh, h_r, n+2 ); if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_i, ldz, z_r, n+2 ); } info_i = LAPACKE_shseqr( LAPACK_ROW_MAJOR, job_i, compz_i, n_i, ilo_i, ihi_i, h_r, ldh_r, wr_i, wi_i, z_r, ldz_r ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, h_r, n+2, h_i, ldh ); if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, z_r, n+2, z_i, ldz ); } failed = compare_shseqr( h, h_i, wr, wr_i, wi, wi_i, z, z_i, info, info_i, compz, ldh, ldz, n ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to shseqr\n" ); } else { printf( "FAILED: row-major high-level interface to shseqr\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( wr != NULL ) { LAPACKE_free( wr ); } if( wr_i != NULL ) { LAPACKE_free( wr_i ); } if( wr_save != NULL ) { LAPACKE_free( wr_save ); } if( wi != NULL ) { LAPACKE_free( wi ); } if( wi_i != NULL ) { LAPACKE_free( wi_i ); } if( wi_save != NULL ) { LAPACKE_free( wi_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; }