Example #1
0
lapack_int LAPACKE_chseqr( int matrix_order, char job, char compz, lapack_int n,
                           lapack_int ilo, lapack_int ihi,
                           lapack_complex_float* h, lapack_int ldh,
                           lapack_complex_float* w, lapack_complex_float* z,
                           lapack_int ldz )
{
    lapack_int info = 0;
    lapack_int lwork = -1;
    lapack_complex_float* work = NULL;
    lapack_complex_float work_query;
    if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_chseqr", -1 );
        return -1;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    /* Optionally check input matrices for NaNs */
    if( LAPACKE_cge_nancheck( matrix_order, n, n, h, ldh ) ) {
        return -7;
    }
    if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) {
        if( LAPACKE_cge_nancheck( matrix_order, n, n, z, ldz ) ) {
            return -10;
        }
    }
#endif
    /* Query optimal working array(s) size */
    info = LAPACKE_chseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh,
                                w, z, ldz, &work_query, lwork );
    if( info != 0 ) {
        goto exit_level_0;
    }
    lwork = LAPACK_C2INT( work_query );
    /* Allocate memory for work arrays */
    work = (lapack_complex_float*)
        LAPACKE_malloc( sizeof(lapack_complex_float) * lwork );
    if( work == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_0;
    }
    /* Call middle-level interface */
    info = LAPACKE_chseqr_work( matrix_order, job, compz, n, ilo, ihi, h, ldh,
                                w, z, ldz, work, lwork );
    /* Release memory and exit */
    LAPACKE_free( work );
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_chseqr", info );
    }
    return info;
}
Example #2
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;
}