lapack_int LAPACKE_sgges_work( int matrix_order, char jobvsl, char jobvsr, char sort, LAPACK_S_SELECT3 selctg, 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* work, lapack_int lwork, lapack_logical* bwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sgges( &jobvsl, &jobvsr, &sort, selctg, &n, a, &lda, b, &ldb, sdim, alphar, alphai, beta, vsl, &ldvsl, vsr, &ldvsr, work, &lwork, bwork, &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_int ldvsl_t = MAX(1,n); lapack_int ldvsr_t = MAX(1,n); float* a_t = NULL; float* b_t = NULL; float* vsl_t = NULL; float* vsr_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_sgges_work", info ); return info; } if( ldb < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_sgges_work", info ); return info; } if( ldvsl < n ) { info = -16; LAPACKE_xerbla( "LAPACKE_sgges_work", info ); return info; } if( ldvsr < n ) { info = -18; LAPACKE_xerbla( "LAPACKE_sgges_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_sgges( &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 = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (float*)LAPACKE_malloc( sizeof(float) * 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 = (float*) LAPACKE_malloc( sizeof(float) * 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 = (float*) LAPACKE_malloc( sizeof(float) * ldvsr_t * MAX(1,n) ); if( vsr_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgges( &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_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( LAPACKE_lsame( jobvsl, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, vsl_t, ldvsl_t, vsl, ldvsl ); } if( LAPACKE_lsame( jobvsr, 'v' ) ) { LAPACKE_sge_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_sgges_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sgges_work", info ); } return info; }
lapack_int LAPACKE_zgtsvx( int matrix_layout, char fact, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, const lapack_complex_double* du, lapack_complex_double* dlf, lapack_complex_double* df, lapack_complex_double* duf, lapack_complex_double* du2, lapack_int* ipiv, const lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, lapack_int ldx, double* rcond, double* ferr, double* berr ) { lapack_int info = 0; double* rwork = NULL; lapack_complex_double* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zgtsvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_zge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { return -14; } if( LAPACKE_z_nancheck( n, d, 1 ) ) { return -7; } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_z_nancheck( n, df, 1 ) ) { return -10; } } if( LAPACKE_z_nancheck( n-1, dl, 1 ) ) { return -6; } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_z_nancheck( n-1, dlf, 1 ) ) { return -9; } } if( LAPACKE_z_nancheck( n-1, du, 1 ) ) { return -8; } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_z_nancheck( n-2, du2, 1 ) ) { return -12; } } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_z_nancheck( n-1, duf, 1 ) ) { return -11; } } #endif /* Allocate memory for working array(s) */ rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * MAX(1,2*n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_zgtsvx_work( matrix_layout, fact, trans, n, nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zgtsvx", info ); } return info; }
lapack_int LAPACKE_ztpqrt2_work( int matrix_order, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* t, lapack_int ldt ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ztpqrt2( &m, &n, a, &lda, b, &ldb, t, &ldt, &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,m); lapack_int ldt_t = MAX(1,n); lapack_complex_double* a_t = NULL; lapack_complex_double* b_t = NULL; lapack_complex_double* t_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -5; LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); return info; } if( ldb < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); return info; } if( ldt < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_ztpqrt2_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; } t_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldt_t * MAX(1,n) ); if( t_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } /* Transpose input matrices */ LAPACKE_zge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_zge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ztpqrt2( &m, &n, a_t, &lda_t, b_t, &ldb_t, t_t, &ldt_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, n, t_t, ldt_t, t, ldt ); /* Release memory and exit */ LAPACKE_free( t_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_ztpqrt2_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ztpqrt2_work", info ); } return info; }
lapack_int LAPACKE_zhbevx_2stage( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, lapack_complex_double* ab, lapack_int ldab, lapack_complex_double* q, lapack_int ldq, double vl, double vu, lapack_int il, lapack_int iu, double abstol, lapack_int* m, double* w, lapack_complex_double* z, lapack_int ldz, lapack_int* ifail ) { lapack_int info = 0; lapack_int lwork = -1; lapack_int* iwork = NULL; double* rwork = NULL; lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zhbevx_2stage", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK if( LAPACKE_get_nancheck() ) { /* Optionally check input matrices for NaNs */ if( LAPACKE_zhb_nancheck( matrix_layout, uplo, n, kd, ab, ldab ) ) { return -7; } if( LAPACKE_d_nancheck( 1, &abstol, 1 ) ) { return -15; } if( LAPACKE_lsame( range, 'v' ) ) { if( LAPACKE_d_nancheck( 1, &vl, 1 ) ) { return -11; } } if( LAPACKE_lsame( range, 'v' ) ) { if( LAPACKE_d_nancheck( 1, &vu, 1 ) ) { return -12; } } } #endif /* Query optimal working array(s) size */ info = LAPACKE_zhbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, &work_query, lwork, rwork, iwork, ifail ); if( info != 0 ) { goto exit_level_0; } lwork = LAPACK_Z2INT( work_query ); /* 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; } rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,7*n) ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_2; } /* Call middle-level interface */ info = LAPACKE_zhbevx_2stage_work( matrix_layout, jobz, range, uplo, n, kd, ab, ldab, q, ldq, vl, vu, il, iu, abstol, m, w, z, ldz, work, lwork, rwork, iwork, ifail ); /* 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_zhbevx_2stage", info ); } return info; }
lapack_int LAPACKE_shseqr_work( 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, float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_shseqr( &job, &compz, &n, &ilo, &ihi, h, &ldh, wr, wi, z, &ldz, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldh_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* h_t = NULL; float* z_t = NULL; /* Check leading dimension(s) */ if( ldh < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); return info; } if( ldz < n ) { info = -12; LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_shseqr( &job, &compz, &n, &ilo, &ihi, h, &ldh_t, wr, wi, z, &ldz_t, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ h_t = (float*)LAPACKE_malloc( sizeof(float) * ldh_t * MAX(1,n) ); if( h_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, n, n, h, ldh, h_t, ldh_t ); if( LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_sge_trans( matrix_order, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_shseqr( &job, &compz, &n, &ilo, &ihi, h_t, &ldh_t, wr, wi, z_t, &ldz_t, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, h_t, ldh_t, h, ldh ); if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( LAPACKE_lsame( compz, 'i' ) || LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( h_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_shseqr_work", info ); } return info; }
lapack_int LAPACKE_cgees_work( int matrix_layout, char jobvs, char sort, LAPACK_C_SELECT1 select, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_int* sdim, lapack_complex_float* w, lapack_complex_float* vs, lapack_int ldvs, lapack_complex_float* work, lapack_int lwork, float* rwork, lapack_logical* bwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cgees( &jobvs, &sort, select, &n, a, &lda, sdim, w, vs, &ldvs, work, &lwork, rwork, bwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldvs_t = MAX(1,n); lapack_complex_float* a_t = NULL; lapack_complex_float* vs_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_cgees_work", info ); return info; } if( ldvs < n ) { info = -11; LAPACKE_xerbla( "LAPACKE_cgees_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_cgees( &jobvs, &sort, select, &n, a, &lda_t, sdim, w, vs, &ldvs_t, work, &lwork, rwork, bwork, &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,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } if( LAPACKE_lsame( jobvs, 'v' ) ) { vs_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldvs_t * MAX(1,n) ); if( vs_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ LAPACKE_cge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_cgees( &jobvs, &sort, select, &n, a_t, &lda_t, sdim, w, vs_t, &ldvs_t, work, &lwork, rwork, bwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); if( LAPACKE_lsame( jobvs, 'v' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, vs_t, ldvs_t, vs, ldvs ); } /* Release memory and exit */ if( LAPACKE_lsame( jobvs, 'v' ) ) { LAPACKE_free( vs_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cgees_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_cgees_work", info ); } return info; }
lapack_int LAPACKE_ssyevr_work( int matrix_layout, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, lapack_int* isuppz, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ssyevr( &jobz, &range, &uplo, &n, a, &lda, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz, isuppz, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || LAPACKE_lsame( range, 'v' ) ) ? n : ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); lapack_int lda_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* a_t = NULL; float* z_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); return info; } if( ldz < ncols_z ) { info = -16; LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_ssyevr( &jobz, &range, &uplo, &n, a, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz_t, isuppz, work, &lwork, iwork, &liwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } if( LAPACKE_lsame( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevr( &jobz, &range, &uplo, &n, a_t, &lda_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, isuppz, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ssyevr_work", info ); } return info; }
lapack_int LAPACKE_cgerfsx_work( int matrix_order, char trans, char equed, lapack_int n, lapack_int nrhs, const lapack_complex_float* a, lapack_int lda, const lapack_complex_float* af, lapack_int ldaf, const lapack_int* ipiv, const float* r, const float* c, const lapack_complex_float* b, lapack_int ldb, lapack_complex_float* x, lapack_int ldx, float* rcond, float* berr, lapack_int n_err_bnds, float* err_bnds_norm, float* err_bnds_comp, lapack_int nparams, float* params, lapack_complex_float* work, float* rwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cgerfsx( &trans, &equed, &n, &nrhs, a, &lda, af, &ldaf, ipiv, r, c, b, &ldb, x, &ldx, rcond, berr, &n_err_bnds, err_bnds_norm, err_bnds_comp, &nparams, params, work, rwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldaf_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); lapack_complex_float* a_t = NULL; lapack_complex_float* af_t = NULL; lapack_complex_float* b_t = NULL; lapack_complex_float* x_t = NULL; float* err_bnds_norm_t = NULL; float* err_bnds_comp_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); return info; } if( ldaf < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); return info; } if( ldb < nrhs ) { info = -14; LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); return info; } if( ldx < nrhs ) { info = -16; LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } af_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldaf_t * MAX(1,n) ); if( af_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } b_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } x_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } err_bnds_norm_t = (float*) LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) ); if( err_bnds_norm_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_4; } err_bnds_comp_t = (float*) LAPACKE_malloc( sizeof(float) * nrhs * MAX(1,n_err_bnds) ); if( err_bnds_comp_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_5; } /* Transpose input matrices */ LAPACKE_cge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); LAPACKE_cge_trans( matrix_order, n, n, af, ldaf, af_t, ldaf_t ); LAPACKE_cge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_cge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_cgerfsx( &trans, &equed, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, berr, &n_err_bnds, err_bnds_norm_t, err_bnds_comp_t, &nparams, params, work, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_norm_t, nrhs, err_bnds_norm, nrhs ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, nrhs ); /* Release memory and exit */ LAPACKE_free( err_bnds_comp_t ); exit_level_5: LAPACKE_free( err_bnds_norm_t ); exit_level_4: LAPACKE_free( x_t ); exit_level_3: LAPACKE_free( b_t ); exit_level_2: LAPACKE_free( af_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_cgerfsx_work", info ); } return info; }
lapack_int LAPACKE_cggbal_work( int matrix_order, char job, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb, lapack_int* ilo, lapack_int* ihi, float* lscale, float* rscale, float* work ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cggbal( &job, &n, a, &lda, b, &ldb, ilo, ihi, lscale, rscale, work, &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_float* a_t = NULL; lapack_complex_float* b_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -5; LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); return info; } if( ldb < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); return info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { a_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { b_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } /* Transpose input matrices */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_cge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); } if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_cge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t ); } /* Call LAPACK function and adjust info */ LAPACK_cggbal( &job, &n, a_t, &lda_t, b_t, &ldb_t, ilo, ihi, lscale, rscale, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); } /* Release memory and exit */ if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_free( b_t ); } exit_level_1: if( LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) || LAPACKE_lsame( job, 'b' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_cggbal_work", info ); } return info; }
lapack_int LAPACKE_dtprfb_work( int matrix_order, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, lapack_int l, const double* v, lapack_int ldv, const double* t, lapack_int ldt, double* a, lapack_int lda, double* b, lapack_int ldb, const double* mywork, lapack_int myldwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v, &ldv, t, &ldt, a, &lda, b, &ldb, mywork, &myldwork ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int r = LAPACKE_lsame( side, 'r' ) ? k : k; lapack_int lda_t = MAX(1,k); lapack_int ldb_t = MAX(1,m); lapack_int ldt_t = MAX(1,ldt); lapack_int ldv_t = MAX(1,ldv); double* v_t = NULL; double* t_t = NULL; double* a_t = NULL; double* b_t = NULL; /* Check leading dimension(s) */ if( lda < m ) { info = -15; LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); return info; } if( ldb < n ) { info = -17; LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); return info; } if( ldt < k ) { info = -13; LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); return info; } if( ldv < k ) { info = -11; LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); return info; } /* Allocate memory for temporary array(s) */ v_t = (double*)LAPACKE_malloc( sizeof(double) * ldv_t * MAX(1,k) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } t_t = (double*)LAPACKE_malloc( sizeof(double) * ldt_t * MAX(1,k) ); if( t_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } /* Transpose input matrices */ LAPACKE_dge_trans( matrix_order, ldv, k, v, ldv, v_t, ldv_t ); LAPACKE_dge_trans( matrix_order, ldt, k, t, ldt, t_t, ldt_t ); LAPACKE_dge_trans( matrix_order, k, m, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_order, m, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_dtprfb( &side, &trans, &direct, &storev, &m, &n, &k, &l, v_t, &ldv_t, t_t, &ldt_t, a_t, &lda_t, b_t, &ldb_t, mywork, &myldwork ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, k, m, a_t, lda_t, a, lda ); LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_3: LAPACKE_free( a_t ); exit_level_2: LAPACKE_free( t_t ); exit_level_1: LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dtprfb_work", info ); } return info; }
lapack_int LAPACKE_zunbdb_work( int matrix_layout, char trans, char signs, lapack_int m, lapack_int p, lapack_int q, lapack_complex_double* x11, lapack_int ldx11, lapack_complex_double* x12, lapack_int ldx12, lapack_complex_double* x21, lapack_int ldx21, lapack_complex_double* x22, lapack_int ldx22, double* theta, double* phi, lapack_complex_double* taup1, lapack_complex_double* taup2, lapack_complex_double* tauq1, lapack_complex_double* tauq2, lapack_complex_double* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11, x12, &ldx12, x21, &ldx21, x22, &ldx22, theta, phi, taup1, taup2, tauq1, tauq2, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrows_x11 = ( LAPACKE_lsame( trans, 'n' ) ? p : q); lapack_int nrows_x12 = ( LAPACKE_lsame( trans, 'n' ) ? p : m-q); lapack_int nrows_x21 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : q); lapack_int nrows_x22 = ( LAPACKE_lsame( trans, 'n' ) ? m-p : m-q); lapack_int ldx11_t = MAX(1,nrows_x11); lapack_int ldx12_t = MAX(1,nrows_x12); lapack_int ldx21_t = MAX(1,nrows_x21); lapack_int ldx22_t = MAX(1,nrows_x22); lapack_complex_double* x11_t = NULL; lapack_complex_double* x12_t = NULL; lapack_complex_double* x21_t = NULL; lapack_complex_double* x22_t = NULL; /* Check leading dimension(s) */ if( ldx11 < q ) { info = -8; LAPACKE_xerbla( "LAPACKE_zunbdb_work", info ); return info; } if( ldx12 < m-q ) { info = -10; LAPACKE_xerbla( "LAPACKE_zunbdb_work", info ); return info; } if( ldx21 < q ) { info = -12; LAPACKE_xerbla( "LAPACKE_zunbdb_work", info ); return info; } if( ldx22 < m-q ) { info = -14; LAPACKE_xerbla( "LAPACKE_zunbdb_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11, &ldx11_t, x12, &ldx12_t, x21, &ldx21_t, x22, &ldx22_t, theta, phi, taup1, taup2, tauq1, tauq2, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ x11_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx11_t * MAX(1,q) ); if( x11_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } x12_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx12_t * MAX(1,m-q) ); if( x12_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } x21_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx21_t * MAX(1,q) ); if( x21_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } x22_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx22_t * MAX(1,m-q) ); if( x22_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } /* Transpose input matrices */ LAPACKE_zge_trans( matrix_layout, nrows_x11, q, x11, ldx11, x11_t, ldx11_t ); LAPACKE_zge_trans( matrix_layout, nrows_x12, m-q, x12, ldx12, x12_t, ldx12_t ); LAPACKE_zge_trans( matrix_layout, nrows_x21, q, x21, ldx21, x21_t, ldx21_t ); LAPACKE_zge_trans( matrix_layout, nrows_x22, m-q, x22, ldx22, x22_t, ldx22_t ); /* Call LAPACK function and adjust info */ LAPACK_zunbdb( &trans, &signs, &m, &p, &q, x11_t, &ldx11_t, x12_t, &ldx12_t, x21_t, &ldx21_t, x22_t, &ldx22_t, theta, phi, taup1, taup2, tauq1, tauq2, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x11, q, x11_t, ldx11_t, x11, ldx11 ); LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x12, m-q, x12_t, ldx12_t, x12, ldx12 ); LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x21, q, x21_t, ldx21_t, x21, ldx21 ); LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_x22, m-q, x22_t, ldx22_t, x22, ldx22 ); /* Release memory and exit */ LAPACKE_free( x22_t ); exit_level_3: LAPACKE_free( x21_t ); exit_level_2: LAPACKE_free( x12_t ); exit_level_1: LAPACKE_free( x11_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zunbdb_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_zunbdb_work", info ); } return info; }
lapack_int LAPACKE_dtrrfs_work( int matrix_layout, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const double* a, lapack_int lda, const double* b, lapack_int ldb, const double* x, lapack_int ldx, double* ferr, double* berr, double* work, lapack_int* iwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dtrrfs( &uplo, &trans, &diag, &n, &nrhs, a, &lda, b, &ldb, x, &ldx, ferr, berr, work, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); double* a_t = NULL; double* b_t = NULL; double* x_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); return info; } if( ldb < nrhs ) { info = -10; LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); return info; } if( ldx < nrhs ) { info = -12; LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); return 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,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } x_t = (double*)LAPACKE_malloc( sizeof(double) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } /* Transpose input matrices */ LAPACKE_dtr_trans( matrix_layout, uplo, diag, n, a, lda, a_t, lda_t ); LAPACKE_dge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_dge_trans( matrix_layout, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_dtrrfs( &uplo, &trans, &diag, &n, &nrhs, a_t, &lda_t, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Release memory and exit */ LAPACKE_free( x_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_dtrrfs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dtrrfs_work", info ); } return info; }
lapack_int LAPACKE_csprfs_work( int matrix_order, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_float* ap, const lapack_complex_float* afp, const lapack_int* ipiv, const lapack_complex_float* b, lapack_int ldb, lapack_complex_float* x, lapack_int ldx, float* ferr, float* berr, lapack_complex_float* work, float* rwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_csprfs( &uplo, &n, &nrhs, ap, afp, ipiv, b, &ldb, x, &ldx, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); lapack_complex_float* b_t = NULL; lapack_complex_float* x_t = NULL; lapack_complex_float* ap_t = NULL; lapack_complex_float* afp_t = NULL; /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); return info; } if( ldx < nrhs ) { info = -11; LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); return info; } /* Allocate memory for temporary array(s) */ b_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } x_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } ap_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( ap_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } afp_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( afp_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } /* Transpose input matrices */ LAPACKE_cge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_cge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t ); LAPACKE_csp_trans( matrix_order, uplo, n, ap, ap_t ); LAPACKE_csp_trans( matrix_order, uplo, n, afp, afp_t ); /* Call LAPACK function and adjust info */ LAPACK_csprfs( &uplo, &n, &nrhs, ap_t, afp_t, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: LAPACKE_free( ap_t ); exit_level_2: LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_csprfs_work", info ); } return info; }
lapack_int LAPACKE_chbgvx_work( int matrix_order, char jobz, char range, char uplo, lapack_int n, lapack_int ka, lapack_int kb, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* bb, lapack_int ldbb, lapack_complex_float* q, lapack_int ldq, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, lapack_complex_float* z, lapack_int ldz, lapack_complex_float* work, float* rwork, lapack_int* iwork, lapack_int* ifail ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_chbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab, &ldab, bb, &ldbb, q, &ldq, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz, work, rwork, iwork, ifail, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldab_t = MAX(1,ka+1); lapack_int ldbb_t = MAX(1,kb+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); lapack_complex_float* ab_t = NULL; lapack_complex_float* bb_t = NULL; lapack_complex_float* q_t = NULL; lapack_complex_float* z_t = NULL; /* Check leading dimension(s) */ if( ldab < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); return info; } if( ldbb < n ) { info = -11; LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); return info; } if( ldq < n ) { info = -13; LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); return info; } if( ldz < n ) { info = -22; LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ ab_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldab_t * MAX(1,n) ); if( ab_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } bb_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldbb_t * MAX(1,n) ); if( bb_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } if( LAPACKE_lsame( jobz, 'v' ) ) { q_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } if( LAPACKE_lsame( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } /* Transpose input matrices */ LAPACKE_chb_trans( matrix_order, uplo, n, ka, ab, ldab, ab_t, ldab_t ); LAPACKE_chb_trans( matrix_order, uplo, n, kb, bb, ldbb, bb_t, ldbb_t ); /* Call LAPACK function and adjust info */ LAPACK_chbgvx( &jobz, &range, &uplo, &n, &ka, &kb, ab_t, &ldab_t, bb_t, &ldbb_t, q_t, &ldq_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, rwork, iwork, ifail, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, ka, ab_t, ldab_t, ab, ldab ); LAPACKE_chb_trans( LAPACK_COL_MAJOR, uplo, n, kb, bb_t, ldbb_t, bb, ldbb ); if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_3: if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_2: LAPACKE_free( bb_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_chbgvx_work", info ); } return info; }
lapack_int LAPACKE_cgbsvxx( int matrix_layout, char fact, char trans, lapack_int n, lapack_int kl, lapack_int ku, lapack_int nrhs, lapack_complex_float* ab, lapack_int ldab, lapack_complex_float* afb, lapack_int ldafb, lapack_int* ipiv, char* equed, float* r, float* c, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* x, lapack_int ldx, float* rcond, float* rpvgrw, float* berr, lapack_int n_err_bnds, float* err_bnds_norm, float* err_bnds_comp, lapack_int nparams, float* params ) { lapack_int info = 0; float* rwork = NULL; lapack_complex_float* work = NULL; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_cgbsvxx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, ku, ab, ldab ) ) { return -8; } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_cgb_nancheck( matrix_layout, n, n, kl, kl+ku, afb, ldafb ) ) { return -10; } } if( LAPACKE_cge_nancheck( matrix_layout, n, nrhs, b, ldb ) ) { return -16; } if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || LAPACKE_lsame( *equed, 'c' ) ) ) { if( LAPACKE_s_nancheck( n, c, 1 ) ) { return -15; } } if( nparams>0 ) { if( LAPACKE_s_nancheck( nparams, params, 1 ) ) { return -27; } } if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { if( LAPACKE_s_nancheck( n, r, 1 ) ) { return -14; } } #endif /* Allocate memory for working array(s) */ rwork = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,3*n) ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * MAX(1,2*n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_cgbsvxx_work( matrix_layout, fact, trans, n, kl, ku, nrhs, ab, ldab, afb, ldafb, ipiv, equed, r, c, b, ldb, x, ldx, rcond, rpvgrw, berr, n_err_bnds, err_bnds_norm, err_bnds_comp, nparams, params, work, rwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cgbsvxx", info ); } return info; }
lapack_int LAPACKE_zgtrfs_work( int matrix_order, char trans, lapack_int n, lapack_int nrhs, const lapack_complex_double* dl, const lapack_complex_double* d, const lapack_complex_double* du, const lapack_complex_double* dlf, const lapack_complex_double* df, const lapack_complex_double* duf, const lapack_complex_double* du2, const lapack_int* ipiv, const lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, lapack_int ldx, double* ferr, double* berr, lapack_complex_double* work, double* rwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b, &ldb, x, &ldx, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); lapack_complex_double* b_t = NULL; lapack_complex_double* x_t = NULL; /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -14; LAPACKE_xerbla( "LAPACKE_zgtrfs_work", info ); return info; } if( ldx < nrhs ) { info = -16; LAPACKE_xerbla( "LAPACKE_zgtrfs_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; } x_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_zge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_zge_trans( matrix_order, n, nrhs, x, ldx, x_t, ldx_t ); /* Call LAPACK function and adjust info */ LAPACK_zgtrfs( &trans, &n, &nrhs, dl, d, du, dlf, df, duf, du2, ipiv, b_t, &ldb_t, x_t, &ldx_t, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zgtrfs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_zgtrfs_work", info ); } return info; }
lapack_int LAPACKE_sspgvx_work( int matrix_order, lapack_int itype, char jobz, char range, char uplo, lapack_int n, float* ap, float* bp, float vl, float vu, lapack_int il, lapack_int iu, float abstol, lapack_int* m, float* w, float* z, lapack_int ldz, float* work, lapack_int* iwork, lapack_int* ifail ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sspgvx( &itype, &jobz, &range, &uplo, &n, ap, bp, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz, work, iwork, ifail, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ncols_z = ( LAPACKE_lsame( range, 'a' ) || LAPACKE_lsame( range, 'v' ) ) ? n : ( LAPACKE_lsame( range, 'i' ) ? (iu-il+1) : 1); lapack_int ldz_t = MAX(1,n); float* z_t = NULL; float* ap_t = NULL; float* bp_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -17; LAPACKE_xerbla( "LAPACKE_sspgvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( jobz, 'v' ) ) { z_t = (float*) LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,ncols_z) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } ap_t = (float*) LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( ap_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } bp_t = (float*) LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( bp_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } /* Transpose input matrices */ LAPACKE_ssp_trans( matrix_order, uplo, n, ap, ap_t ); LAPACKE_ssp_trans( matrix_order, uplo, n, bp, bp_t ); /* Call LAPACK function and adjust info */ LAPACK_sspgvx( &itype, &jobz, &range, &uplo, &n, ap_t, bp_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, iwork, ifail, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, ncols_z, z_t, ldz_t, z, ldz ); } LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); LAPACKE_ssp_trans( LAPACK_COL_MAJOR, uplo, n, bp_t, bp ); /* Release memory and exit */ LAPACKE_free( bp_t ); exit_level_2: LAPACKE_free( ap_t ); exit_level_1: if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sspgvx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sspgvx_work", info ); } return info; }
lapack_int LAPACKE_zgesdd_work( int matrix_layout, char jobz, lapack_int m, lapack_int n, lapack_complex_double* a, lapack_int lda, double* s, lapack_complex_double* u, lapack_int ldu, lapack_complex_double* vt, lapack_int ldvt, lapack_complex_double* work, lapack_int lwork, double* rwork, lapack_int* iwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zgesdd( &jobz, &m, &n, a, &lda, s, u, &ldu, vt, &ldvt, work, &lwork, rwork, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int nrows_u = ( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? m : 1; lapack_int ncols_u = ( LAPACKE_lsame( jobz, 'a' ) || ( LAPACKE_lsame( jobz, 'o' ) && m<n) ) ? m : ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1); lapack_int nrows_vt = ( LAPACKE_lsame( jobz, 'a' ) || ( LAPACKE_lsame( jobz, 'o' ) && m>=n) ) ? n : ( LAPACKE_lsame( jobz, 's' ) ? MIN(m,n) : 1); lapack_int lda_t = MAX(1,m); lapack_int ldu_t = MAX(1,nrows_u); lapack_int ldvt_t = MAX(1,nrows_vt); lapack_complex_double* a_t = NULL; lapack_complex_double* u_t = NULL; lapack_complex_double* vt_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); return info; } if( ldu < ncols_u ) { info = -9; LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); return info; } if( ldvt < n ) { info = -11; LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_zgesdd( &jobz, &m, &n, a, &lda_t, s, u, &ldu_t, vt, &ldvt_t, work, &lwork, rwork, iwork, &info ); return (info < 0) ? (info - 1) : 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; } if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) { u_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldu_t * MAX(1,ncols_u) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) { vt_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldvt_t * MAX(1,n) ); if( vt_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } /* Transpose input matrices */ LAPACKE_zge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_zgesdd( &jobz, &m, &n, a_t, &lda_t, s, u_t, &ldu_t, vt_t, &ldvt_t, work, &lwork, rwork, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_u, ncols_u, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) { LAPACKE_zge_trans( LAPACK_COL_MAJOR, nrows_vt, n, vt_t, ldvt_t, vt, ldvt ); } /* Release memory and exit */ if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || ( LAPACKE_lsame( jobz, 'o' ) && (m>=n) ) ) { LAPACKE_free( vt_t ); } exit_level_2: if( LAPACKE_lsame( jobz, 'a' ) || LAPACKE_lsame( jobz, 's' ) || ( LAPACKE_lsame( jobz, 'o' ) && (m<n) ) ) { LAPACKE_free( u_t ); } exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_zgesdd_work", info ); } return info; }
lapack_int LAPACKE_zhesvx( int matrix_order, char fact, char uplo, lapack_int n, lapack_int nrhs, const lapack_complex_double* a, lapack_int lda, lapack_complex_double* af, lapack_int ldaf, lapack_int* ipiv, const lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, lapack_int ldx, double* rcond, double* ferr, double* berr ) { lapack_int info = 0; lapack_int lwork = -1; double* rwork = NULL; lapack_complex_double* work = NULL; lapack_complex_double work_query; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_zhesvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_zhe_nancheck( matrix_order, uplo, n, a, lda ) ) { return -6; } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_zhe_nancheck( matrix_order, uplo, n, af, ldaf ) ) { return -8; } } if( LAPACKE_zge_nancheck( matrix_order, n, nrhs, b, ldb ) ) { return -11; } #endif /* Allocate memory for working array(s) */ rwork = (double*)LAPACKE_malloc( sizeof(double) * MAX(1,n) ); if( rwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Query optimal working array(s) size */ info = LAPACKE_zhesvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, &work_query, lwork, rwork ); if( info != 0 ) { goto exit_level_1; } lwork = LAPACK_Z2INT( work_query ); /* Allocate memory for work arrays */ work = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * lwork ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_zhesvx_work( matrix_order, fact, uplo, n, nrhs, a, lda, af, ldaf, ipiv, b, ldb, x, ldx, rcond, ferr, berr, work, lwork, rwork ); /* Release memory and exit */ LAPACKE_free( work ); exit_level_1: LAPACKE_free( rwork ); exit_level_0: if( info == LAPACK_WORK_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zhesvx", info ); } return info; }
lapack_int LAPACKE_strsyl_work( int matrix_order, char trana, char tranb, lapack_int isgn, lapack_int m, lapack_int n, const float* a, lapack_int lda, const float* b, lapack_int ldb, float* c, lapack_int ldc, float* scale ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_strsyl( &trana, &tranb, &isgn, &m, &n, a, &lda, b, &ldb, c, &ldc, scale, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); lapack_int ldb_t = MAX(1,n); lapack_int ldc_t = MAX(1,m); float* a_t = NULL; float* b_t = NULL; float* c_t = NULL; /* Check leading dimension(s) */ if( lda < m ) { info = -8; LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); return info; } if( ldb < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); return info; } if( ldc < n ) { info = -12; LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,m) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) ); if( c_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, m, m, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_order, n, n, b, ldb, b_t, ldb_t ); LAPACKE_sge_trans( matrix_order, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_strsyl( &trana, &tranb, &isgn, &m, &n, a_t, &lda_t, b_t, &ldb_t, c_t, &ldc_t, scale, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, c_t, ldc_t, c, ldc ); /* Release memory and exit */ LAPACKE_free( c_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_strsyl_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_strsyl_work", info ); } return info; }
lapack_int LAPACKE_dormlq_work( int matrix_layout, 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_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dormlq( &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 ) { r = LAPACKE_lsame( side, 'l' ) ? m : n; lda_t = MAX(1,k); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < r ) { info = -8; LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); return info; } if( ldc < n ) { info = -11; LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_dormlq( &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) */ if( LAPACKE_lsame( side, 'l' ) ) { a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,m) ); } else { 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; } 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 */ if( LAPACKE_lsame( side, 'l' ) ){ LAPACKE_dge_trans( matrix_layout, k, m, a, lda, a_t, lda_t ); } else { LAPACKE_dge_trans( matrix_layout, k, n, a, lda, a_t, lda_t ); } LAPACKE_dge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_dormlq( &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_dormlq_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dormlq_work", info ); } return info; }
lapack_int LAPACKE_cggrqf_work( int matrix_layout, lapack_int m, lapack_int p, lapack_int n, lapack_complex_float* a, lapack_int lda, lapack_complex_float* taua, lapack_complex_float* b, lapack_int ldb, lapack_complex_float* taub, lapack_complex_float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cggrqf( &m, &p, &n, a, &lda, taua, b, &ldb, taub, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); lapack_int ldb_t = MAX(1,p); lapack_complex_float* a_t = NULL; lapack_complex_float* b_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_cggrqf_work", info ); return info; } if( ldb < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_cggrqf_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_cggrqf( &m, &p, &n, a, &lda_t, taua, b, &ldb_t, taub, 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,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_cge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); LAPACKE_cge_trans( matrix_layout, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cggrqf( &m, &p, &n, a_t, &lda_t, taua, b_t, &ldb_t, taub, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); LAPACKE_cge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); /* 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_cggrqf_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_cggrqf_work", info ); } return info; }
lapack_int LAPACKE_sgesvx_work( int matrix_order, char fact, char trans, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, lapack_int* ipiv, char* equed, float* r, float* c, float* b, lapack_int ldb, float* x, lapack_int ldx, float* rcond, float* ferr, float* berr, float* work, lapack_int* iwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sgesvx( &fact, &trans, &n, &nrhs, a, &lda, af, &ldaf, ipiv, equed, r, c, b, &ldb, x, &ldx, rcond, ferr, berr, work, iwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldaf_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); float* a_t = NULL; float* af_t = NULL; float* b_t = NULL; float* x_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_sgesvx_work", info ); return info; } if( ldaf < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_sgesvx_work", info ); return info; } if( ldb < nrhs ) { info = -15; LAPACKE_xerbla( "LAPACKE_sgesvx_work", info ); return info; } if( ldx < nrhs ) { info = -17; LAPACKE_xerbla( "LAPACKE_sgesvx_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } af_t = (float*)LAPACKE_malloc( sizeof(float) * ldaf_t * MAX(1,n) ); if( af_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } x_t = (float*)LAPACKE_malloc( sizeof(float) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); if( LAPACKE_lsame( fact, 'f' ) ) { LAPACKE_sge_trans( matrix_order, n, n, af, ldaf, af_t, ldaf_t ); } LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sgesvx( &fact, &trans, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, ipiv, equed, r, c, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( fact, 'e' ) && ( LAPACKE_lsame( *equed, 'b' ) || LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, af_t, ldaf_t, af, ldaf ); } if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || LAPACKE_lsame( *equed, 'c' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); } LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); /* Release memory and exit */ LAPACKE_free( x_t ); exit_level_3: LAPACKE_free( b_t ); exit_level_2: LAPACKE_free( af_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sgesvx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sgesvx_work", info ); } return info; }
lapack_int LAPACKE_clarfb( int matrix_layout, char side, char trans, char direct, char storev, lapack_int m, lapack_int n, lapack_int k, const lapack_complex_float* v, lapack_int ldv, const lapack_complex_float* t, lapack_int ldt, lapack_complex_float* c, lapack_int ldc ) { lapack_int info = 0; lapack_int ldwork = ( side=='l')?n:(( side=='r')?m:1); lapack_complex_float* work = NULL; lapack_int ncols_v, nrows_v; if( matrix_layout != LAPACK_COL_MAJOR && matrix_layout != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_clarfb", -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_cge_nancheck( matrix_layout, m, n, c, ldc ) ) { return -13; } if( LAPACKE_cge_nancheck( matrix_layout, k, k, t, ldt ) ) { return -11; } if( LAPACKE_lsame( storev, 'c' ) && LAPACKE_lsame( direct, 'f' ) ) { if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, v, ldv ) ) return -9; if( LAPACKE_cge_nancheck( matrix_layout, 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_clarfb", -8 ); return -8; } if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, &v[(nrows_v-k)*ldv], ldv ) ) return -9; if( LAPACKE_cge_nancheck( matrix_layout, nrows_v-k, ncols_v, v, ldv ) ) return -9; } else if( LAPACKE_lsame( storev, 'r' ) && LAPACKE_lsame( direct, 'f' ) ) { if( LAPACKE_ctr_nancheck( matrix_layout, 'u', 'u', k, v, ldv ) ) return -9; if( LAPACKE_cge_nancheck( matrix_layout, 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_clarfb", -8 ); return -8; } if( LAPACKE_ctr_nancheck( matrix_layout, 'l', 'u', k, &v[ncols_v-k], ldv ) ) return -9; if( LAPACKE_cge_nancheck( matrix_layout, nrows_v, ncols_v-k, v, ldv ) ) return -9; } #endif /* Allocate memory for working array(s) */ work = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldwork * MAX(1,k) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } /* Call middle-level interface */ info = LAPACKE_clarfb_work( matrix_layout, 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_clarfb", info ); } return info; }
lapack_int LAPACKE_cstemr_work( int matrix_layout, char jobz, char range, lapack_int n, float* d, float* e, float vl, float vu, lapack_int il, lapack_int iu, lapack_int* m, float* w, lapack_complex_float* z, lapack_int ldz, lapack_int nzc, lapack_int* isuppz, lapack_logical* tryrac, float* work, lapack_int lwork, lapack_int* iwork, lapack_int liwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z, &ldz, &nzc, isuppz, tryrac, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldz_t = MAX(1,n); lapack_complex_float* z_t = NULL; /* Check leading dimension(s) */ if( ldz < n ) { info = -14; LAPACKE_xerbla( "LAPACKE_cstemr_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_cstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z, &ldz_t, &nzc, isuppz, tryrac, work, &lwork, iwork, &liwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( jobz, 'v' ) ) { z_t = (lapack_complex_float*) LAPACKE_malloc( sizeof(lapack_complex_float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } } /* Call LAPACK function and adjust info */ LAPACK_cstemr( &jobz, &range, &n, d, e, &vl, &vu, &il, &iu, m, w, z_t, &ldz_t, &nzc, isuppz, tryrac, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( z_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_cstemr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_cstemr_work", info ); } return info; }
lapack_int LAPACKE_stgexc_work( int matrix_layout, lapack_logical wantq, lapack_logical wantz, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* q, lapack_int ldq, float* z, lapack_int ldz, lapack_int* ifst, lapack_int* ilst, float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_stgexc( &wantq, &wantz, &n, a, &lda, b, &ldb, q, &ldq, z, &ldz, ifst, ilst, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* a_t = NULL; float* b_t = NULL; float* q_t = NULL; float* z_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); return info; } if( ldb < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); return info; } if( ldq < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); return info; } if( ldz < n ) { info = -12; LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_stgexc( &wantq, &wantz, &n, a, &lda_t, b, &ldb_t, q, &ldq_t, z, &ldz_t, ifst, ilst, work, &lwork, &info ); return (info < 0) ? (info - 1) : info; } /* Allocate memory for temporary array(s) */ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,n) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,n) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } if( wantq ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } if( wantz ) { z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); if( wantq ) { LAPACKE_sge_trans( matrix_layout, n, n, q, ldq, q_t, ldq_t ); } if( wantz ) { LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_stgexc( &wantq, &wantz, &n, a_t, &lda_t, b_t, &ldb_t, q_t, &ldq_t, z_t, &ldz_t, ifst, ilst, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); if( wantq ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } if( wantz ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); } /* Release memory and exit */ if( wantz ) { LAPACKE_free( z_t ); } exit_level_3: if( wantq ) { LAPACKE_free( q_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_stgexc_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_stgexc_work", info ); } return info; }
lapack_int LAPACKE_sgesvx( int matrix_order, char fact, char trans, lapack_int n, lapack_int nrhs, float* a, lapack_int lda, float* af, lapack_int ldaf, lapack_int* ipiv, char* equed, float* r, float* c, float* b, lapack_int ldb, float* x, lapack_int ldx, float* rcond, float* ferr, float* berr, float* rpivot ) { lapack_int info = 0; lapack_int* iwork = NULL; float* work = NULL; if( matrix_order != LAPACK_COL_MAJOR && matrix_order != LAPACK_ROW_MAJOR ) { LAPACKE_xerbla( "LAPACKE_sgesvx", -1 ); return -1; } #ifndef LAPACK_DISABLE_NAN_CHECK /* Optionally check input matrices for NaNs */ if( LAPACKE_sge_nancheck( matrix_order, n, n, a, lda ) ) { return -6; } if( LAPACKE_lsame( fact, 'f' ) ) { if( LAPACKE_sge_nancheck( matrix_order, n, n, af, ldaf ) ) { return -8; } } if( LAPACKE_sge_nancheck( matrix_order, n, nrhs, b, ldb ) ) { return -14; } if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || LAPACKE_lsame( *equed, 'c' ) ) ) { if( LAPACKE_s_nancheck( n, c, 1 ) ) { return -13; } } if( LAPACKE_lsame( fact, 'f' ) && ( LAPACKE_lsame( *equed, 'b' ) || LAPACKE_lsame( *equed, 'r' ) ) ) { if( LAPACKE_s_nancheck( n, r, 1 ) ) { return -12; } } #endif /* Allocate memory for working array(s) */ iwork = (lapack_int*)LAPACKE_malloc( sizeof(lapack_int) * MAX(1,n) ); if( iwork == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_0; } work = (float*)LAPACKE_malloc( sizeof(float) * MAX(1,4*n) ); if( work == NULL ) { info = LAPACK_WORK_MEMORY_ERROR; goto exit_level_1; } /* Call middle-level interface */ info = LAPACKE_sgesvx_work( matrix_order, fact, trans, n, nrhs, a, lda, af, ldaf, ipiv, equed, r, c, b, ldb, x, ldx, rcond, ferr, berr, work, iwork ); /* Backup significant data from working array(s) */ *rpivot = work[0]; /* 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_sgesvx", info ); } return info; }
lapack_int LAPACKE_zppsvx_work( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_double* ap, lapack_complex_double* afp, char* equed, double* s, lapack_complex_double* b, lapack_int ldb, lapack_complex_double* x, lapack_int ldx, double* rcond, double* ferr, double* berr, lapack_complex_double* work, double* rwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_zppsvx( &fact, &uplo, &n, &nrhs, ap, afp, equed, s, b, &ldb, x, &ldx, rcond, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,n); lapack_int ldx_t = MAX(1,n); lapack_complex_double* b_t = NULL; lapack_complex_double* x_t = NULL; lapack_complex_double* ap_t = NULL; lapack_complex_double* afp_t = NULL; /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -11; LAPACKE_xerbla( "LAPACKE_zppsvx_work", info ); return info; } if( ldx < nrhs ) { info = -13; LAPACKE_xerbla( "LAPACKE_zppsvx_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; } x_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ldx_t * MAX(1,nrhs) ); if( x_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } 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_2; } afp_t = (lapack_complex_double*) LAPACKE_malloc( sizeof(lapack_complex_double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( afp_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } /* Transpose input matrices */ LAPACKE_zge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_zpp_trans( matrix_layout, uplo, n, ap, ap_t ); if( LAPACKE_lsame( fact, 'f' ) ) { LAPACKE_zpp_trans( matrix_layout, uplo, n, afp, afp_t ); } /* Call LAPACK function and adjust info */ LAPACK_zppsvx( &fact, &uplo, &n, &nrhs, ap_t, afp_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, ferr, berr, work, rwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); LAPACKE_zge_trans( LAPACK_COL_MAJOR, n, nrhs, x_t, ldx_t, x, ldx ); if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, ap_t, ap ); } if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { LAPACKE_zpp_trans( LAPACK_COL_MAJOR, uplo, n, afp_t, afp ); } /* Release memory and exit */ LAPACKE_free( afp_t ); exit_level_3: LAPACKE_free( ap_t ); exit_level_2: LAPACKE_free( x_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_zppsvx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_zppsvx_work", info ); } return info; }
int main(void) { /* Local scalars */ lapack_int itype, itype_i; char uplo, uplo_i; lapack_int n, n_i; lapack_int lda, lda_i; lapack_int lda_r; lapack_int ldb, ldb_i; lapack_int ldb_r; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ double *a = NULL, *a_i = NULL; double *b = NULL, *b_i = NULL; double *a_save = NULL; double *a_r = NULL; double *b_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_dsygst( &itype, &uplo, &n, &lda, &ldb ); lda_r = n+2; ldb_r = n+2; itype_i = itype; uplo_i = uplo; n_i = n; lda_i = lda; ldb_i = ldb; /* Allocate memory for the LAPACK routine arrays */ a = (double *)LAPACKE_malloc( lda*n * sizeof(double) ); b = (double *)LAPACKE_malloc( ldb*n * sizeof(double) ); /* Allocate memory for the C interface function arrays */ a_i = (double *)LAPACKE_malloc( lda*n * sizeof(double) ); b_i = (double *)LAPACKE_malloc( ldb*n * sizeof(double) ); /* Allocate memory for the backup arrays */ a_save = (double *)LAPACKE_malloc( lda*n * sizeof(double) ); /* Allocate memory for the row-major arrays */ a_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) ); b_r = (double *)LAPACKE_malloc( n*(n+2) * sizeof(double) ); /* Initialize input arrays */ init_a( lda*n, a ); init_b( ldb*n, b ); /* Backup the ouptut arrays */ for( i = 0; i < lda*n; i++ ) { a_save[i] = a[i]; } /* Call the LAPACK routine */ dsygst_( &itype, &uplo, &n, a, &lda, b, &ldb, &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 < ldb*n; i++ ) { b_i[i] = b[i]; } info_i = LAPACKE_dsygst_work( LAPACK_COL_MAJOR, itype_i, uplo_i, n_i, a_i, lda_i, b_i, ldb_i ); failed = compare_dsygst( a, a_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to dsygst\n" ); } else { printf( "FAILED: column-major middle-level interface to dsygst\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 < ldb*n; i++ ) { b_i[i] = b[i]; } info_i = LAPACKE_dsygst( LAPACK_COL_MAJOR, itype_i, uplo_i, n_i, a_i, lda_i, b_i, ldb_i ); failed = compare_dsygst( a, a_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to dsygst\n" ); } else { printf( "FAILED: column-major high-level interface to dsygst\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 < ldb*n; i++ ) { b_i[i] = b[i]; } LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_i, ldb, b_r, n+2 ); info_i = LAPACKE_dsygst_work( LAPACK_ROW_MAJOR, itype_i, uplo_i, n_i, a_r, lda_r, b_r, ldb_r ); LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda ); failed = compare_dsygst( a, a_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to dsygst\n" ); } else { printf( "FAILED: row-major middle-level interface to dsygst\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 < ldb*n; i++ ) { b_i[i] = b[i]; } /* Init row_major arrays */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, n, b_i, ldb, b_r, n+2 ); info_i = LAPACKE_dsygst( LAPACK_ROW_MAJOR, itype_i, uplo_i, n_i, a_r, lda_r, b_r, ldb_r ); LAPACKE_dge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda ); failed = compare_dsygst( a, a_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to dsygst\n" ); } else { printf( "FAILED: row-major high-level interface to dsygst\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( b != NULL ) { LAPACKE_free( b ); } if( b_i != NULL ) { LAPACKE_free( b_i ); } if( b_r != NULL ) { LAPACKE_free( b_r ); } 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 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 r; lapack_int i; int failed; /* Local arrays */ double *a = NULL, *a_i = NULL; double *tau = NULL, *tau_i = NULL; double *c = NULL, *c_i = NULL; double *work = NULL, *work_i = NULL; double *c_save = NULL; double *a_r = NULL; double *c_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_dormqr( &side, &trans, &m, &n, &k, &lda, &ldc, &lwork ); r = LAPACKE_lsame( side, 'l' ) ? m : n; lda_r = k+2; ldc_r = n+2; 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 = (double *)LAPACKE_malloc( lda*k * sizeof(double) ); tau = (double *)LAPACKE_malloc( k * sizeof(double) ); c = (double *)LAPACKE_malloc( ldc*n * sizeof(double) ); work = (double *)LAPACKE_malloc( lwork * sizeof(double) ); /* Allocate memory for the C interface function arrays */ a_i = (double *)LAPACKE_malloc( lda*k * sizeof(double) ); tau_i = (double *)LAPACKE_malloc( k * sizeof(double) ); c_i = (double *)LAPACKE_malloc( ldc*n * sizeof(double) ); work_i = (double *)LAPACKE_malloc( lwork * sizeof(double) ); /* Allocate memory for the backup arrays */ c_save = (double *)LAPACKE_malloc( ldc*n * sizeof(double) ); /* Allocate memory for the row-major arrays */ a_r = (double *)LAPACKE_malloc( r*(k+2) * sizeof(double) ); c_r = (double *)LAPACKE_malloc( m*(n+2) * sizeof(double) ); /* Initialize input arrays */ init_a( lda*k, a ); init_tau( 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 */ dormqr_( &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*k; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 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_dormqr_work( LAPACK_COL_MAJOR, 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_dormqr( c, c_i, info, info_i, ldc, n ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to dormqr\n" ); } else { printf( "FAILED: column-major middle-level interface to dormqr\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*k; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 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_dormqr( LAPACK_COL_MAJOR, side_i, trans_i, m_i, n_i, k_i, a_i, lda_i, tau_i, c_i, ldc_i ); failed = compare_dormqr( c, c_i, info, info_i, ldc, n ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to dormqr\n" ); } else { printf( "FAILED: column-major high-level interface to dormqr\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*k; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 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_dge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 ); LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 ); info_i = LAPACKE_dormqr_work( LAPACK_ROW_MAJOR, 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_dge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc ); failed = compare_dormqr( c, c_i, info, info_i, ldc, n ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to dormqr\n" ); } else { printf( "FAILED: row-major middle-level interface to dormqr\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*k; i++ ) { a_i[i] = a[i]; } for( i = 0; i < 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_dge_trans( LAPACK_COL_MAJOR, r, k, a_i, lda, a_r, k+2 ); LAPACKE_dge_trans( LAPACK_COL_MAJOR, m, n, c_i, ldc, c_r, n+2 ); info_i = LAPACKE_dormqr( LAPACK_ROW_MAJOR, side_i, trans_i, m_i, n_i, k_i, a_r, lda_r, tau_i, c_r, ldc_r ); LAPACKE_dge_trans( LAPACK_ROW_MAJOR, m, n, c_r, n+2, c_i, ldc ); failed = compare_dormqr( c, c_i, info, info_i, ldc, n ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to dormqr\n" ); } else { printf( "FAILED: row-major high-level interface to dormqr\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; }