当前位置: 首页>>代码示例>>C++>>正文


C++ LAPACKE_free函数代码示例

本文整理汇总了C++中LAPACKE_free函数的典型用法代码示例。如果您正苦于以下问题:C++ LAPACKE_free函数的具体用法?C++ LAPACKE_free怎么用?C++ LAPACKE_free使用的例子?那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。


在下文中一共展示了LAPACKE_free函数的15个代码示例,这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞,您的评价将有助于系统推荐出更棒的C++代码示例。

示例1: LAPACKE_zsptrs_work

lapack_int LAPACKE_zsptrs_work( int matrix_layout, char uplo, lapack_int n,
                                lapack_int nrhs,
                                const lapack_complex_double* ap,
                                const lapack_int* ipiv,
                                lapack_complex_double* b, lapack_int ldb )
{
    lapack_int info = 0;
    if( matrix_layout == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_zsptrs( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
        lapack_int ldb_t = MAX(1,n);
        lapack_complex_double* b_t = NULL;
        lapack_complex_double* ap_t = NULL;
        /* Check leading dimension(s) */
        if( ldb < nrhs ) {
            info = -8;
            LAPACKE_xerbla( "LAPACKE_zsptrs_work", info );
            return info;
        }
        /* Allocate memory for temporary array(s) */
        b_t = (lapack_complex_double*)
            LAPACKE_malloc( sizeof(lapack_complex_double) *
                            ldb_t * MAX(1,nrhs) );
        if( b_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        ap_t = (lapack_complex_double*)
            LAPACKE_malloc( sizeof(lapack_complex_double) *
                            ( MAX(1,n) * MAX(2,n+1) ) / 2 );
        if( ap_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_1;
        }
        /* Transpose input matrices */
        LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t );
        LAPACKE_zsp_trans( matrix_layout, uplo, n, ap, ap_t );
        /* Call LAPACK function and adjust info */
        LAPACK_zsptrs( &uplo, &n, &nrhs, ap_t, ipiv, b_t, &ldb_t, &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb );
        /* Release memory and exit */
        LAPACKE_free( ap_t );
exit_level_1:
        LAPACKE_free( b_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_zsptrs_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_zsptrs_work", info );
    }
    return info;
}
开发者ID:4ker,项目名称:OpenBLAS,代码行数:62,代码来源:lapacke_zsptrs_work.c

示例2: LAPACKE_dbdsdc_work

lapack_int LAPACKE_dbdsdc_work( int matrix_order, char uplo, char compq,
                                lapack_int n, double* d, double* e, double* u,
                                lapack_int ldu, double* vt, lapack_int ldvt,
                                double* q, lapack_int* iq, double* work,
                                lapack_int* iwork )
{
    lapack_int info = 0;
    if( matrix_order == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u, &ldu, vt, &ldvt, q, iq, work,
                       iwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_order == LAPACK_ROW_MAJOR ) {
        lapack_int ldu_t = MAX(1,n);
        lapack_int ldvt_t = MAX(1,n);
        double* u_t = NULL;
        double* vt_t = NULL;
        /* Check leading dimension(s) */
        if( ldu < n ) {
            info = -8;
            LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
            return info;
        }
        if( ldvt < n ) {
            info = -10;
            LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
            return info;
        }
        /* Allocate memory for temporary array(s) */
        if( LAPACKE_lsame( compq, 'i' ) ) {
            u_t = (double*)LAPACKE_malloc( sizeof(double) * ldu_t * MAX(1,n) );
            if( u_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_0;
            }
        }
        if( LAPACKE_lsame( compq, 'i' ) ) {
            vt_t = (double*)
                LAPACKE_malloc( sizeof(double) * ldvt_t * MAX(1,n) );
            if( vt_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_1;
            }
        }
        /* Call LAPACK function and adjust info */
        LAPACK_dbdsdc( &uplo, &compq, &n, d, e, u_t, &ldu_t, vt_t, &ldvt_t, q,
                       iq, work, iwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        if( LAPACKE_lsame( compq, 'i' ) ) {
            LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, u_t, ldu_t, u, ldu );
        }
        if( LAPACKE_lsame( compq, 'i' ) ) {
            LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vt_t, ldvt_t, vt, ldvt );
        }
        /* Release memory and exit */
        if( LAPACKE_lsame( compq, 'i' ) ) {
            LAPACKE_free( vt_t );
        }
exit_level_1:
        if( LAPACKE_lsame( compq, 'i' ) ) {
            LAPACKE_free( u_t );
        }
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_dbdsdc_work", info );
    }
    return info;
}
开发者ID:Bres-Tech,项目名称:libswiftnav,代码行数:77,代码来源:lapacke_dbdsdc_work.c

示例3: LAPACKE_dtrexc_work

lapack_int LAPACKE_dtrexc_work( int matrix_layout, char compq, lapack_int n,
                                double* t, lapack_int ldt, double* q,
                                lapack_int ldq, lapack_int* ifst,
                                lapack_int* ilst, double* work )
{
    lapack_int info = 0;
    if( matrix_layout == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_dtrexc( &compq, &n, t, &ldt, q, &ldq, ifst, ilst, work, &info );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
        lapack_int ldq_t = MAX(1,n);
        lapack_int ldt_t = MAX(1,n);
        double* t_t = NULL;
        double* q_t = NULL;
        /* Check leading dimension(s) */
        if( ldq < n ) {
            info = -7;
            LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
            return info;
        }
        if( ldt < n ) {
            info = -5;
            LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
            return info;
        }
        /* Allocate memory for temporary array(s) */
        t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,n) );
        if( t_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        if( LAPACKE_lsame( compq, 'v' ) ) {
            q_t = (double*)LAPACKE_malloc( sizeof(double) * ldq_t * MAX(1,n) );
            if( q_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_1;
            }
        }
        /* Transpose input matrices */
        LAPACKE_dge_trans( matrix_layout, n, n, t, ldt, t_t, ldt_t );
        if( LAPACKE_lsame( compq, 'v' ) ) {
            LAPACKE_dge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t );
        }
        /* Call LAPACK function and adjust info */
        LAPACK_dtrexc( &compq, &n, t_t, &ldt_t, q_t, &ldq_t, ifst, ilst, work,
                       &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt );
        if( LAPACKE_lsame( compq, 'v' ) ) {
            LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq );
        }
        /* Release memory and exit */
        if( LAPACKE_lsame( compq, 'v' ) ) {
            LAPACKE_free( q_t );
        }
exit_level_1:
        LAPACKE_free( t_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_dtrexc_work", info );
    }
    return info;
}
开发者ID:OpenCMISS-Dependencies,项目名称:lapack,代码行数:73,代码来源:lapacke_dtrexc_work.c

示例4: LAPACKE_sggesx

lapack_int LAPACKE_sggesx( int matrix_layout, char jobvsl, char jobvsr,
                           char sort, LAPACK_S_SELECT3 selctg, char sense,
                           lapack_int n, float* a, lapack_int lda, float* b,
                           lapack_int ldb, lapack_int* sdim, float* alphar,
                           float* alphai, float* beta, float* vsl,
                           lapack_int ldvsl, float* vsr, lapack_int ldvsr,
                           float* rconde, float* rcondv )
{
    lapack_int info = 0;
    lapack_int liwork = -1;
    lapack_int lwork = -1;
    lapack_logical* bwork = NULL;
    lapack_int* iwork = NULL;
    float* work = NULL;
    lapack_int iwork_query;
    float work_query;
    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_sggesx", -1 );
        return -1;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    /* Optionally check input matrices for NaNs */
    if( LAPACKE_sge_nancheck( matrix_layout, n, n, a, lda ) ) {
        return -8;
    }
    if( LAPACKE_sge_nancheck( matrix_layout, n, n, b, ldb ) ) {
        return -10;
    }
#endif
    /* Allocate memory for working array(s) */
    if( LAPACKE_lsame( sort, 's' ) ) {
        bwork = (lapack_logical*)
            LAPACKE_malloc( sizeof(lapack_logical) * MAX(1,n) );
        if( bwork == NULL ) {
            info = LAPACK_WORK_MEMORY_ERROR;
            goto exit_level_0;
        }
    }
    /* Query optimal working array(s) size */
    info = LAPACKE_sggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg,
                                sense, n, a, lda, b, ldb, sdim, alphar, alphai,
                                beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv,
                                &work_query, lwork, &iwork_query, liwork,
                                bwork );
    if( info != 0 ) {
        goto exit_level_1;
    }
    liwork = (lapack_int)iwork_query;
    lwork = (lapack_int)work_query;
    /* Allocate memory for work arrays */
    iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
    if( iwork == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_1;
    }
    work = (float*)LAPACKE_malloc( sizeof(float) * lwork );
    if( work == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_2;
    }
    /* Call middle-level interface */
    info = LAPACKE_sggesx_work( matrix_layout, jobvsl, jobvsr, sort, selctg,
                                sense, n, a, lda, b, ldb, sdim, alphar, alphai,
                                beta, vsl, ldvsl, vsr, ldvsr, rconde, rcondv,
                                work, lwork, iwork, liwork, bwork );
    /* Release memory and exit */
    LAPACKE_free( work );
exit_level_2:
    LAPACKE_free( iwork );
exit_level_1:
    if( LAPACKE_lsame( sort, 's' ) ) {
        LAPACKE_free( bwork );
    }
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_sggesx", info );
    }
    return info;
}
开发者ID:OpenCMISS-Dependencies,项目名称:lapack,代码行数:79,代码来源:lapacke_sggesx.c

示例5: LAPACKE_dormql_work

lapack_int LAPACKE_dormql_work( int matrix_order, char side, char trans,
                                lapack_int m, lapack_int n, lapack_int k,
                                const double* a, lapack_int lda,
                                const double* tau, double* c, lapack_int ldc,
                                double* work, lapack_int lwork )
{
    lapack_int info = 0;
    lapack_int r;
    lapack_int lda_t, ldc_t;
    double *a_t = NULL, *c_t = NULL;
    if( matrix_order == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_dormql( &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc, work,
                       &lwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_order == LAPACK_ROW_MAJOR ) {
        r = LAPACKE_lsame( side, 'l' ) ? m : n;
        lda_t = MAX(1,r);
        ldc_t = MAX(1,m);
        /* Check leading dimension(s) */
        if( lda < k ) {
            info = -8;
            LAPACKE_xerbla( "LAPACKE_dormql_work", info );
            return info;
        }
        if( ldc < n ) {
            info = -11;
            LAPACKE_xerbla( "LAPACKE_dormql_work", info );
            return info;
        }
        /* Query optimal working array(s) size if requested */
        if( lwork == -1 ) {
            LAPACK_dormql( &side, &trans, &m, &n, &k, a, &lda_t, tau, c, &ldc_t,
                           work, &lwork, &info );
            return (info < 0) ? (info - 1) : info;
        }
        /* Allocate memory for temporary array(s) */
        a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,k) );
        if( a_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        c_t = (double*)LAPACKE_malloc( sizeof(double) * ldc_t * MAX(1,n) );
        if( c_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_1;
        }
        /* Transpose input matrices */
        LAPACKE_dge_trans( matrix_order, r, k, a, lda, a_t, lda_t );
        LAPACKE_dge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t );
        /* Call LAPACK function and adjust info */
        LAPACK_dormql( &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t, &ldc_t,
                       work, &lwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
        /* Release memory and exit */
        LAPACKE_free( c_t );
exit_level_1:
        LAPACKE_free( a_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_dormql_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_dormql_work", info );
    }
    return info;
}
开发者ID:2php,项目名称:netlib-java,代码行数:74,代码来源:lapacke_dormql_work.c

示例6: LAPACKE_dgejsv

lapack_int LAPACKE_dgejsv( int matrix_layout, char joba, char jobu, char jobv,
                           char jobr, char jobt, char jobp, lapack_int m,
                           lapack_int n, double* a, lapack_int lda, double* sva,
                           double* u, lapack_int ldu, double* v, lapack_int ldv,
                           double* stat, lapack_int* istat )
{
    lapack_int info = 0;
    lapack_int lwork = (!( LAPACKE_lsame( jobu, 'u' ) ||
                       LAPACKE_lsame( jobu, 'f' ) ||
                       LAPACKE_lsame( jobv, 'v' ) ||
                       LAPACKE_lsame( jobv, 'j' ) ||
                       LAPACKE_lsame( joba, 'e' ) ||
                       LAPACKE_lsame( joba, 'g' ) ) ? MAX3(7,4*n+1,2*m+n) :
                       ( (!( LAPACKE_lsame( jobu, 'u' ) ||
                       LAPACKE_lsame( jobu, 'f' ) ||
                       LAPACKE_lsame( jobv, 'v' ) ||
                       LAPACKE_lsame( jobv, 'j' ) ) &&
                       ( LAPACKE_lsame( joba, 'e' ) ||
                       LAPACKE_lsame( joba, 'g' ) ) ) ? MAX3(7,4*n+n*n,2*m+n) :
                       ( ( LAPACKE_lsame( jobu, 'u' ) ||
                       LAPACKE_lsame( jobu, 'f' ) ) &&
                       (!( LAPACKE_lsame( jobv, 'v' ) ||
                       LAPACKE_lsame( jobv, 'j' ) ) ) ? MAX(7,2*n+m) :
                       ( ( LAPACKE_lsame( jobv, 'v' ) ||
                       LAPACKE_lsame( jobv, 'j' ) ) &&
                       (!( LAPACKE_lsame( jobu, 'u' ) ||
                       LAPACKE_lsame( jobu, 'f' ) ) ) ? MAX(7,2*n+m) :
                       ( ( LAPACKE_lsame( jobu, 'u' ) ||
                       LAPACKE_lsame( jobu, 'f' ) ) &&
                       ( LAPACKE_lsame( jobv, 'v' ) ||
                       LAPACKE_lsame( jobv, 'j' ) ) &&
                       !LAPACKE_lsame( jobv, 'j' ) ? MAX(1,6*n+2*n*n) :
                       ( ( LAPACKE_lsame( jobu, 'u' ) ||
                       LAPACKE_lsame( jobu, 'f' ) ) &&
                       ( LAPACKE_lsame( jobv, 'v' ) ||
                       LAPACKE_lsame( jobv, 'j' ) ) &&
                       LAPACKE_lsame( jobv, 'j' ) ? MAX(7,m+3*n+n*n) :
                       7) ) ) ) ) );
    lapack_int* iwork = NULL;
    double* work = NULL;
    lapack_int i;
    lapack_int nu, nv;
    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_dgejsv", -1 );
        return -1;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    /* Optionally check input matrices for NaNs */
    nu = LAPACKE_lsame( jobu, 'n' ) ? 1 : m;
    nv = LAPACKE_lsame( jobv, 'n' ) ? 1 : n;
    if( LAPACKE_dge_nancheck( matrix_layout, m, n, a, lda ) ) {
        return -10;
    }
#endif
    /* Allocate memory for working array(s) */
    iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(3,m+3*n) );
    if( iwork == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_0;
    }
    lwork = MAX3( lwork, 7, 2*m+n );
    { /* FIXUP LWORK */
        int want_u = LAPACKE_lsame( jobu, 'u' ) || LAPACKE_lsame( jobu, 'f' );
        int want_v = LAPACKE_lsame( jobv, 'v' ) || LAPACKE_lsame( jobv, 'j' );
        int want_sce = LAPACKE_lsame( joba, 'e' ) || LAPACKE_lsame( joba, 'g' );
        if( !want_u && !want_v && !want_sce )  lwork = MAX( lwork, 4*n+1 ); // 1.1
        if( !want_u && !want_v && want_sce )   lwork = MAX( lwork, n*n+4*n ); // 1.2
        if( !want_u && want_v ) lwork = MAX( lwork, 4*n+1 ); // 2
        if( want_u && !want_v ) lwork = MAX( lwork, 4*n+1 ); // 3
        if( want_u && LAPACKE_lsame( jobv, 'v' ) ) lwork = MAX( lwork, 6*n+2*n*n ); // 4.1
        if( want_u && LAPACKE_lsame( jobv, 'j' ) ) lwork = MAX3( lwork, 4*n+n*n, 2*n+n*n+6 ); // 4.2
    }
    work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
    if( work == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_1;
    }
    /* Call middle-level interface */
    info = LAPACKE_dgejsv_work( matrix_layout, joba, jobu, jobv, jobr, jobt,
                                jobp, m, n, a, lda, sva, u, ldu, v, ldv, work,
                                lwork, iwork );
    /* Backup significant data from working array(s) */
    for( i=0; i<7; i++ ) {
        stat[i] = work[i];
    }
    for( i=0; i<3; i++ ) {
        istat[i] = iwork[i];
    }
    /* Release memory and exit */
    LAPACKE_free( work );
exit_level_1:
    LAPACKE_free( iwork );
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_dgejsv", info );
    }
    return info;
}
开发者ID:ChinaQuants,项目名称:OpenBLAS,代码行数:98,代码来源:lapacke_dgejsv.c

示例7: LAPACKE_dgges3_work


//.........这里部分代码省略.........
        double* vsl_t = NULL;
        double* vsr_t = NULL;
        /* Check leading dimension(s) */
        if( lda < n ) {
            info = -8;
            LAPACKE_xerbla( "LAPACKE_dgges3_work", info );
            return info;
        }
        if( ldb < n ) {
            info = -10;
            LAPACKE_xerbla( "LAPACKE_dgges3_work", info );
            return info;
        }
        if( ldvsl < n ) {
            info = -16;
            LAPACKE_xerbla( "LAPACKE_dgges3_work", info );
            return info;
        }
        if( ldvsr < n ) {
            info = -18;
            LAPACKE_xerbla( "LAPACKE_dgges3_work", info );
            return info;
        }
        /* Query optimal working array(s) size if requested */
        if( lwork == -1 ) {
            LAPACK_dgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda_t, b,
                           &ldb_t, sdim, alphar, alphai, beta, vsl, &ldvsl_t,
                           vsr, &ldvsr_t, work, &lwork, bwork, &info );
            return (info < 0) ? (info - 1) : info;
        }
        /* Allocate memory for temporary array(s) */
        a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,n) );
        if( a_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) );
        if( b_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_1;
        }
        if( LAPACKE_lsame( jobvsl, 'v' ) ) {
            vsl_t = (double*)
                LAPACKE_malloc( sizeof(double) * ldvsl_t * MAX(1,n) );
            if( vsl_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_2;
            }
        }
        if( LAPACKE_lsame( jobvsr, 'v' ) ) {
            vsr_t = (double*)
                LAPACKE_malloc( sizeof(double) * ldvsr_t * MAX(1,n) );
            if( vsr_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_3;
            }
        }
        /* Transpose input matrices */
        LAPACKE_dge_trans( matrix_layout, n, n, a, lda, a_t, lda_t );
        LAPACKE_dge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t );
        /* Call LAPACK function and adjust info */
        LAPACK_dgges3( &jobvsl, &jobvsr, &sort, selctg, &n, a_t, &lda_t, b_t,
                       &ldb_t, sdim, alphar, alphai, beta, vsl_t, &ldvsl_t,
                       vsr_t, &ldvsr_t, work, &lwork, bwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda );
        LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb );
        if( LAPACKE_lsame( jobvsl, 'v' ) ) {
            LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl,
                               ldvsl );
        }
        if( LAPACKE_lsame( jobvsr, 'v' ) ) {
            LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, vsr_t, ldvsr_t, vsr,
                               ldvsr );
        }
        /* Release memory and exit */
        if( LAPACKE_lsame( jobvsr, 'v' ) ) {
            LAPACKE_free( vsr_t );
        }
exit_level_3:
        if( LAPACKE_lsame( jobvsl, 'v' ) ) {
            LAPACKE_free( vsl_t );
        }
exit_level_2:
        LAPACKE_free( b_t );
exit_level_1:
        LAPACKE_free( a_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_dgges3_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_dgges3_work", info );
    }
    return info;
}
开发者ID:4ker,项目名称:OpenBLAS,代码行数:101,代码来源:lapacke_dgges3_work.c

示例8: LAPACKE_dsyevx

lapack_int LAPACKE_dsyevx( int matrix_order, char jobz, char range, char uplo,
                           lapack_int n, double* a, lapack_int lda, double vl,
                           double vu, lapack_int il, lapack_int iu,
                           double abstol, lapack_int* m, double* w, double* z,
                           lapack_int ldz, lapack_int* ifail )
{
    lapack_int info = 0;
    lapack_int lwork = -1;
    lapack_int* iwork = NULL;
    double* work = NULL;
    double work_query;
    if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_dsyevx", -1 );
        return -1;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    /* Optionally check input matrices for NaNs */
    if( LAPACKE_dsy_nancheck( matrix_order, uplo, n, a, lda ) ) {
        return -6;
    }
    if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) {
        return -12;
    }
    if( LAPACKE_lsame( range, 'v' ) ) {
        if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
            return -8;
        }
    }
    if( LAPACKE_lsame( range, 'v' ) ) {
        if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
            return -9;
        }
    }
#endif
    /* Allocate memory for working array(s) */
    iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,5*n) );
    if( iwork == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_0;
    }
    /* Query optimal working array(s) size */
    info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
                                vu, il, iu, abstol, m, w, z, ldz, &work_query,
                                lwork, iwork, ifail );
    if( info != 0 ) {
        goto exit_level_1;
    }
    lwork = (lapack_int)work_query;
    /* Allocate memory for work arrays */
    work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
    if( work == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_1;
    }
    /* Call middle-level interface */
    info = LAPACKE_dsyevx_work( matrix_order, jobz, range, uplo, n, a, lda, vl,
                                vu, il, iu, abstol, m, w, z, ldz, work, lwork,
                                iwork, ifail );
    /* Release memory and exit */
    LAPACKE_free( work );
exit_level_1:
    LAPACKE_free( iwork );
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_dsyevx", info );
    }
    return info;
}
开发者ID:Bres-Tech,项目名称:libswiftnav,代码行数:68,代码来源:lapacke_dsyevx.c

示例9: LAPACKE_cunmbr_work

lapack_int LAPACKE_cunmbr_work( int matrix_layout, char vect, char side,
                                char trans, lapack_int m, lapack_int n,
                                lapack_int k, const lapack_complex_float* a,
                                lapack_int lda, const lapack_complex_float* tau,
                                lapack_complex_float* c, lapack_int ldc,
                                lapack_complex_float* work, lapack_int lwork )
{
    lapack_int info = 0;
    if( matrix_layout == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_cunmbr( &vect, &side, &trans, &m, &n, &k, a, &lda, tau, c, &ldc,
                       work, &lwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
        lapack_int nq = LAPACKE_lsame( side, 'l' ) ? m : n;
        lapack_int r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k);
        lapack_int lda_t = MAX(1,r);
        lapack_int ldc_t = MAX(1,m);
        lapack_complex_float* a_t = NULL;
        lapack_complex_float* c_t = NULL;
        /* Check leading dimension(s) */
        if( lda < MIN(nq,k) ) {
            info = -9;
            LAPACKE_xerbla( "LAPACKE_cunmbr_work", info );
            return info;
        }
        if( ldc < n ) {
            info = -12;
            LAPACKE_xerbla( "LAPACKE_cunmbr_work", info );
            return info;
        }
        /* Query optimal working array(s) size if requested */
        if( lwork == -1 ) {
            LAPACK_cunmbr( &vect, &side, &trans, &m, &n, &k, a, &lda_t, tau, c,
                           &ldc_t, work, &lwork, &info );
            return (info < 0) ? (info - 1) : info;
        }
        /* Allocate memory for temporary array(s) */
        a_t = (lapack_complex_float*)
            LAPACKE_malloc( sizeof(lapack_complex_float) *
                            lda_t * MAX(1,MIN(nq,k)) );
        if( a_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        c_t = (lapack_complex_float*)
            LAPACKE_malloc( sizeof(lapack_complex_float) * ldc_t * MAX(1,n) );
        if( c_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_1;
        }
        /* Transpose input matrices */
        LAPACKE_cge_trans( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t );
        LAPACKE_cge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t );
        /* Call LAPACK function and adjust info */
        LAPACK_cunmbr( &vect, &side, &trans, &m, &n, &k, a_t, &lda_t, tau, c_t,
                       &ldc_t, work, &lwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc );
        /* Release memory and exit */
        LAPACKE_free( c_t );
exit_level_1:
        LAPACKE_free( a_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_cunmbr_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_cunmbr_work", info );
    }
    return info;
}
开发者ID:4ker,项目名称:OpenBLAS,代码行数:78,代码来源:lapacke_cunmbr_work.c

示例10: LAPACKE_zhegst_work

lapack_int LAPACKE_zhegst_work( int matrix_order, lapack_int itype, char uplo,
                                lapack_int n, lapack_complex_double* a,
                                lapack_int lda, const lapack_complex_double* b,
                                lapack_int ldb )
{
    lapack_int info = 0;
    if( matrix_order == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_zhegst( &itype, &uplo, &n, a, &lda, b, &ldb, &info );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_order == LAPACK_ROW_MAJOR ) {
        lapack_int lda_t = MAX(1,n);
        lapack_int ldb_t = MAX(1,n);
        lapack_complex_double* a_t = NULL;
        lapack_complex_double* b_t = NULL;
        /* Check leading dimension(s) */
        if( lda < n ) {
            info = -6;
            LAPACKE_xerbla( "LAPACKE_zhegst_work", info );
            return info;
        }
        if( ldb < n ) {
            info = -8;
            LAPACKE_xerbla( "LAPACKE_zhegst_work", info );
            return info;
        }
        /* Allocate memory for temporary array(s) */
        a_t = (lapack_complex_double*)
            LAPACKE_malloc( sizeof(lapack_complex_double) * lda_t * MAX(1,n) );
        if( a_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        b_t = (lapack_complex_double*)
            LAPACKE_malloc( sizeof(lapack_complex_double) * ldb_t * MAX(1,n) );
        if( b_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_1;
        }
        /* Transpose input matrices */
        LAPACKE_zhe_trans( matrix_order, uplo, n, a, lda, a_t, lda_t );
        LAPACKE_zge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t );
        /* Call LAPACK function and adjust info */
        LAPACK_zhegst( &itype, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        LAPACKE_zhe_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda );
        /* Release memory and exit */
        LAPACKE_free( b_t );
exit_level_1:
        LAPACKE_free( a_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_zhegst_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_zhegst_work", info );
    }
    return info;
}
开发者ID:Bres-Tech,项目名称:libswiftnav,代码行数:65,代码来源:lapacke_zhegst_work.c

示例11: LAPACKE_dstemr

lapack_int LAPACKE_dstemr( int matrix_layout, char jobz, char range,
                           lapack_int n, double* d, double* e, double vl,
                           double vu, lapack_int il, lapack_int iu,
                           lapack_int* m, double* w, double* z, lapack_int ldz,
                           lapack_int nzc, lapack_int* isuppz,
                           lapack_logical* tryrac )
{
    lapack_int info = 0;
    lapack_int liwork = -1;
    lapack_int lwork = -1;
    lapack_int* iwork = NULL;
    double* work = NULL;
    lapack_int iwork_query;
    double work_query;
    if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_dstemr", -1 );
        return -1;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    if( LAPACKE_get_nancheck() ) {
        /* Optionally check input matrices for NaNs */
        if( LAPACKE_d_nancheck( n, d, 1 ) ) {
            return -5;
        }
        if( LAPACKE_d_nancheck( n-1, e, 1 ) ) {
            return -6;
        }
        if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) {
            return -7;
        }
        if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) {
            return -8;
        }
    }
#endif
    /* Query optimal working array(s) size */
    info = LAPACKE_dstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il,
                                iu, m, w, z, ldz, nzc, isuppz, tryrac,
                                &work_query, lwork, &iwork_query, liwork );
    if( info != 0 ) {
        goto exit_level_0;
    }
    liwork = (lapack_int)iwork_query;
    lwork = (lapack_int)work_query;
    /* Allocate memory for work arrays */
    iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * liwork );
    if( iwork == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_0;
    }
    work = (double*)LAPACKE_malloc( sizeof(double) * lwork );
    if( work == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_1;
    }
    /* Call middle-level interface */
    info = LAPACKE_dstemr_work( matrix_layout, jobz, range, n, d, e, vl, vu, il,
                                iu, m, w, z, ldz, nzc, isuppz, tryrac, work,
                                lwork, iwork, liwork );
    /* Release memory and exit */
    LAPACKE_free( work );
exit_level_1:
    LAPACKE_free( iwork );
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_dstemr", info );
    }
    return info;
}
开发者ID:Reference-LAPACK,项目名称:lapack,代码行数:69,代码来源:lapacke_dstemr.c

示例12: LAPACKE_stfsm_work

lapack_int LAPACKE_stfsm_work( int matrix_layout, char transr, char side,
                               char uplo, char trans, char diag, lapack_int m,
                               lapack_int n, float alpha, const float* a,
                               float* b, lapack_int ldb )
{
    lapack_int info = 0;
    if( matrix_layout == LAPACK_COL_MAJOR ) {
        /* Call LAPACK function and adjust info */
        LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a,
                      b, &ldb );
        if( info < 0 ) {
            info = info - 1;
        }
    } else if( matrix_layout == LAPACK_ROW_MAJOR ) {
        lapack_int ldb_t = MAX(1,m);
        float* b_t = NULL;
        float* a_t = NULL;
        /* Check leading dimension(s) */
        if( ldb < n ) {
            info = -12;
            LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
            return info;
        }
        /* Allocate memory for temporary array(s) */
        b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) );
        if( b_t == NULL ) {
            info = LAPACK_TRANSPOSE_MEMORY_ERROR;
            goto exit_level_0;
        }
        if( IS_S_NONZERO(alpha) ) {
            a_t = (float*)
                LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 );
            if( a_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_1;
            }
        }
        /* Transpose input matrices */
        if( IS_S_NONZERO(alpha) ) {
            LAPACKE_sge_trans( matrix_layout, m, n, b, ldb, b_t, ldb_t );
        }
        if( IS_S_NONZERO(alpha) ) {
            LAPACKE_stf_trans( matrix_layout, transr, uplo, diag, n, a, a_t );
        }
        /* Call LAPACK function and adjust info */
        LAPACK_stfsm( &transr, &side, &uplo, &trans, &diag, &m, &n, &alpha, a_t,
                      b_t, &ldb_t );
        info = 0;  /* LAPACK call is ok! */
        /* Transpose output matrices */
        LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb );
        /* Release memory and exit */
        if( IS_S_NONZERO(alpha) ) {
            LAPACKE_free( a_t );
        }
exit_level_1:
        LAPACKE_free( b_t );
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_stfsm_work", info );
    }
    return info;
}
开发者ID:OpenCMISS-Dependencies,项目名称:lapack,代码行数:66,代码来源:lapacke_stfsm_work.c

示例13: LAPACKE_cgesdd

lapack_int LAPACKE_cgesdd( int matrix_order, char jobz, lapack_int m,
                           lapack_int n, lapack_complex_float* a,
                           lapack_int lda, float* s, lapack_complex_float* u,
                           lapack_int ldu, lapack_complex_float* vt,
                           lapack_int ldvt )
{
    lapack_int info = 0;
    lapack_int lwork = -1;
    /* Additional scalars declarations for work arrays */
    size_t lrwork;
    lapack_int* iwork = NULL;
    float* rwork = NULL;
    lapack_complex_float* work = NULL;
    lapack_complex_float work_query;
    if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_cgesdd", -1 );
        return -1;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    /* Optionally check input matrices for NaNs */
    if( LAPACKE_cge_nancheck( matrix_order, m, n, a, lda ) ) {
        return -5;
    }
#endif
    /* Additional scalars initializations for work arrays */
    if( LAPACKE_lsame( jobz, 'n' ) ) {
        lrwork = MAX(1,5*MIN(m,n));
    } else {
        lrwork = (size_t)5*MAX(1,MIN(m,n))*MAX(1,MIN(m,n))+7*MIN(m,n);
    }
    /* Allocate memory for working array(s) */
    iwork = (lapack_int*)
        LAPACKE_malloc( sizeof(lapack_int) * MAX(1,8*MIN(m,n)) );
    if( iwork == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_0;
    }
    rwork = (float*)LAPACKE_malloc( sizeof(float) * lrwork );
    if( rwork == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_1;
    }
    /* Query optimal working array(s) size */
    info = LAPACKE_cgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
                                ldvt, &work_query, lwork, rwork, iwork );
    if( info != 0 ) {
        goto exit_level_2;
    }
    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_2;
    }
    /* Call middle-level interface */
    info = LAPACKE_cgesdd_work( matrix_order, jobz, m, n, a, lda, s, u, ldu, vt,
                                ldvt, work, lwork, rwork, iwork );
    /* Release memory and exit */
    LAPACKE_free( work );
exit_level_2:
    LAPACKE_free( rwork );
exit_level_1:
    LAPACKE_free( iwork );
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_cgesdd", info );
    }
    return info;
}
开发者ID:checco74,项目名称:uquantchem,代码行数:71,代码来源:lapacke_cgesdd.c

示例14: LAPACKE_zlarfb

lapack_int LAPACKE_zlarfb( int matrix_order, char side, char trans, char direct,
                           char storev, lapack_int m, lapack_int n,
                           lapack_int k, const lapack_complex_double* v,
                           lapack_int ldv, const lapack_complex_double* t,
                           lapack_int ldt, lapack_complex_double* c,
                           lapack_int ldc )
{
    lapack_int info = 0;
    lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1);
    lapack_complex_double* work = NULL;
    lapack_int ncols_v, nrows_v;
    if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) {
        LAPACKE_xerbla( "LAPACKE_zlarfb", -1 );
        return -1;
    }
#ifndef LAPACK_DISABLE_NAN_CHECK
    /* Optionally check input matrices for NaNs */
    ncols_v = LAPACKE_lsame( storev, 'c' ) ? k :
                         ( ( LAPACKE_lsame( storev, 'r' ) &&
                         LAPACKE_lsame( side, 'l' ) ) ? m :
                         ( ( LAPACKE_lsame( storev, 'r' ) &&
                         LAPACKE_lsame( side, 'r' ) ) ? n : 1) );
    nrows_v = ( LAPACKE_lsame( storev, 'c' ) &&
                         LAPACKE_lsame( side, 'l' ) ) ? m :
                         ( ( LAPACKE_lsame( storev, 'c' ) &&
                         LAPACKE_lsame( side, 'r' ) ) ? n :
                         ( LAPACKE_lsame( storev, 'r' ) ? k : 1) );
    if( LAPACKE_zge_nancheck( matrix_order, m, n, c, ldc ) ) {
        return -13;
    }
    if( LAPACKE_zge_nancheck( matrix_order, k, k, t, ldt ) ) {
        return -11;
    }
    if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) {
        if( LAPACKE_ztr_nancheck( matrix_order, 'l', 'u', k, v, ldv ) )
            return -9;
        if( LAPACKE_zge_nancheck( matrix_order, nrows_v-k, ncols_v, &v[k*ldv],
            ldv ) )
            return -9;
    } else if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'b' ) ) {
        if( k > nrows_v ) {
            LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
            return -8;
        }
        if( LAPACKE_ztr_nancheck( matrix_order, 'u', 'u', k,
            &v[(nrows_v-k)*ldv], ldv ) )
            return -9;
        if( LAPACKE_zge_nancheck( matrix_order, nrows_v-k, ncols_v, v, ldv ) )
            return -9;
    } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
        if( LAPACKE_ztr_nancheck( matrix_order, 'u', 'u', k, v, ldv ) )
            return -9;
        if( LAPACKE_zge_nancheck( matrix_order, nrows_v, ncols_v-k, &v[k],
            ldv ) )
            return -9;
    } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) {
        if( k > ncols_v ) {
            LAPACKE_xerbla( "LAPACKE_zlarfb", -8 );
            return -8;
        }
        if( LAPACKE_ztr_nancheck( matrix_order, 'l', 'u', k, &v[ncols_v-k],
            ldv ) )
            return -9;
        if( LAPACKE_zge_nancheck( matrix_order, nrows_v, ncols_v-k, v, ldv ) )
            return -9;
    }
#endif
    /* Allocate memory for working array(s) */
    work = (lapack_complex_double*)
        LAPACKE_malloc( sizeof(lapack_complex_double) * ldwork * MAX(1,k) );
    if( work == NULL ) {
        info = LAPACK_WORK_MEMORY_ERROR;
        goto exit_level_0;
    }
    /* Call middle-level interface */
    info = LAPACKE_zlarfb_work( matrix_order, side, trans, direct, storev, m, n,
                                k, v, ldv, t, ldt, c, ldc, work, ldwork );
    /* Release memory and exit */
    LAPACKE_free( work );
exit_level_0:
    if( info == LAPACK_WORK_MEMORY_ERROR ) {
        LAPACKE_xerbla( "LAPACKE_zlarfb", info );
    }
    return info;
}
开发者ID:BOHICAMAN,项目名称:OpenBLAS,代码行数:85,代码来源:lapacke_zlarfb.c

示例15: LAPACKE_sbbcsd_work


//.........这里部分代码省略.........
        /* Allocate memory for temporary array(s) */
        if( LAPACKE_lsame( jobu1, 'y' ) ) {
            u1_t = (float*)LAPACKE_malloc( sizeof(float) * ldu1_t * MAX(1,p) );
            if( u1_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_0;
            }
        }
        if( LAPACKE_lsame( jobu2, 'y' ) ) {
            u2_t = (float*)
                   LAPACKE_malloc( sizeof(float) * ldu2_t * MAX(1,m-p) );
            if( u2_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_1;
            }
        }
        if( LAPACKE_lsame( jobv1t, 'y' ) ) {
            v1t_t = (float*)
                    LAPACKE_malloc( sizeof(float) * ldv1t_t * MAX(1,q) );
            if( v1t_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_2;
            }
        }
        if( LAPACKE_lsame( jobv2t, 'y' ) ) {
            v2t_t = (float*)
                    LAPACKE_malloc( sizeof(float) * ldv2t_t * MAX(1,m-q) );
            if( v2t_t == NULL ) {
                info = LAPACK_TRANSPOSE_MEMORY_ERROR;
                goto exit_level_3;
            }
        }
        /* Transpose input matrices */
        if( LAPACKE_lsame( jobu1, 'y' ) ) {
            LAPACKE_sge_trans( matrix_layout, nrows_u1, p, u1, ldu1, u1_t,
                               ldu1_t );
        }
        if( LAPACKE_lsame( jobu2, 'y' ) ) {
            LAPACKE_sge_trans( matrix_layout, nrows_u2, m-p, u2, ldu2, u2_t,
                               ldu2_t );
        }
        if( LAPACKE_lsame( jobv1t, 'y' ) ) {
            LAPACKE_sge_trans( matrix_layout, nrows_v1t, q, v1t, ldv1t, v1t_t,
                               ldv1t_t );
        }
        if( LAPACKE_lsame( jobv2t, 'y' ) ) {
            LAPACKE_sge_trans( matrix_layout, nrows_v2t, m-q, v2t, ldv2t, v2t_t,
                               ldv2t_t );
        }
        /* Call LAPACK function and adjust info */
        LAPACK_sbbcsd( &jobu1, &jobu2, &jobv1t, &jobv2t, &trans, &m, &p, &q,
                       theta, phi, u1_t, &ldu1_t, u2_t, &ldu2_t, v1t_t,
                       &ldv1t_t, v2t_t, &ldv2t_t, b11d, b11e, b12d, b12e, b21d,
                       b21e, b22d, b22e, work, &lwork, &info );
        if( info < 0 ) {
            info = info - 1;
        }
        /* Transpose output matrices */
        if( LAPACKE_lsame( jobu1, 'y' ) ) {
            LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u1, p, u1_t, ldu1_t, u1,
                               ldu1 );
        }
        if( LAPACKE_lsame( jobu2, 'y' ) ) {
            LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_u2, m-p, u2_t, ldu2_t,
                               u2, ldu2 );
        }
        if( LAPACKE_lsame( jobv1t, 'y' ) ) {
            LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v1t, q, v1t_t, ldv1t_t,
                               v1t, ldv1t );
        }
        if( LAPACKE_lsame( jobv2t, 'y' ) ) {
            LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_v2t, m-q, v2t_t, ldv2t_t,
                               v2t, ldv2t );
        }
        /* Release memory and exit */
        if( LAPACKE_lsame( jobv2t, 'y' ) ) {
            LAPACKE_free( v2t_t );
        }
exit_level_3:
        if( LAPACKE_lsame( jobv1t, 'y' ) ) {
            LAPACKE_free( v1t_t );
        }
exit_level_2:
        if( LAPACKE_lsame( jobu2, 'y' ) ) {
            LAPACKE_free( u2_t );
        }
exit_level_1:
        if( LAPACKE_lsame( jobu1, 'y' ) ) {
            LAPACKE_free( u1_t );
        }
exit_level_0:
        if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) {
            LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
        }
    } else {
        info = -1;
        LAPACKE_xerbla( "LAPACKE_sbbcsd_work", info );
    }
    return info;
}
开发者ID:asteever,项目名称:lapack,代码行数:101,代码来源:lapacke_sbbcsd_work.c


注:本文中的LAPACKE_free函数示例由纯净天空整理自Github/MSDocs等开源代码及文档管理平台,相关代码片段筛选自各路编程大神贡献的开源项目,源码版权归原作者所有,传播和使用请参考对应项目的License;未经允许,请勿转载。