lapack_int LAPACKE_sgebal_work( int matrix_order, char job, lapack_int n, float* a, lapack_int lda, lapack_int* ilo, lapack_int* ihi, float* scale ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sgebal( &job, &n, a, &lda, ilo, ihi, scale, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -5; LAPACKE_xerbla( "LAPACKE_sgebal_work", info ); return info; } /* Allocate memory for temporary array(s) */ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, '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; } } /* Transpose input matrices */ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ) { LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); } /* Call LAPACK function and adjust info */ LAPACK_sgebal( &job, &n, a_t, &lda_t, ilo, ihi, scale, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); } /* Release memory and exit */ if( LAPACKE_lsame( job, 'b' ) || LAPACKE_lsame( job, 'p' ) || LAPACKE_lsame( job, 's' ) ) { LAPACKE_free( a_t ); } exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sgebal_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sgebal_work", info ); } return info; }
lapack_int LAPACKE_stptrs_work( int matrix_order, char uplo, char trans, char diag, lapack_int n, lapack_int nrhs, const float* ap, float* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_stptrs( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,n); float* b_t = NULL; float* ap_t = NULL; /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -9; LAPACKE_xerbla( "LAPACKE_stptrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) ); if( b_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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_stp_trans( matrix_order, uplo, diag, n, ap, ap_t ); /* Call LAPACK function and adjust info */ LAPACK_stptrs( &uplo, &trans, &diag, &n, &nrhs, ap_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_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_stptrs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_stptrs_work", info ); } return info; }
lapack_int LAPACKE_ssyevd_2stage_work( int matrix_layout, char jobz, char uplo, lapack_int n, float* a, lapack_int lda, float* w, 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_ssyevd_2stage( &jobz, &uplo, &n, a, &lda, w, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_ssyevd_2stage( &jobz, &uplo, &n, a, &lda_t, w, 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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_ssyevd_2stage( &jobz, &uplo, &n, a_t, &lda_t, w, work, &lwork, iwork, &liwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ssyevd_2stage_work", info ); } return info; }
lapack_int LAPACKE_sorgbr_work( int matrix_order, char vect, lapack_int m, lapack_int n, lapack_int k, float* a, lapack_int lda, const float* tau, float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sorgbr( &vect, &m, &n, &k, a, &lda, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_sorgbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_sorgbr( &vect, &m, &n, &k, a, &lda_t, tau, 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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sorgbr( &vect, &m, &n, &k, a_t, &lda_t, tau, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sorgbr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sorgbr_work", info ); } return info; }
lapack_int LAPACKE_slatms_work( int matrix_order, lapack_int m, lapack_int n, char dist, lapack_int* iseed, char sym, float* d, lapack_int mode, float cond, float dmax, lapack_int kl, lapack_int ku, char pack, float* a, lapack_int lda, float* work ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_slatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl, &ku, &pack, a, &lda, work, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -15; LAPACKE_xerbla( "LAPACKE_slatms_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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slatms( &m, &n, &dist, iseed, &sym, d, &mode, &cond, &dmax, &kl, &ku, &pack, a_t, &lda_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_slatms_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_slatms_work", info ); } return info; }
lapack_int LAPACKE_sgebak_work( int matrix_order, char job, char side, lapack_int n, lapack_int ilo, lapack_int ihi, const float* scale, lapack_int m, float* v, lapack_int ldv ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v, &ldv, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldv_t = MAX(1,n); float* v_t = NULL; /* Check leading dimension(s) */ if( ldv < m ) { info = -10; LAPACKE_xerbla( "LAPACKE_sgebak_work", info ); return info; } /* Allocate memory for temporary array(s) */ v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,m) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, n, m, v, ldv, v_t, ldv_t ); /* Call LAPACK function and adjust info */ LAPACK_sgebak( &job, &side, &n, &ilo, &ihi, scale, &m, v_t, &ldv_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, m, v_t, ldv_t, v, ldv ); /* Release memory and exit */ LAPACKE_free( v_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sgebak_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sgebak_work", info ); } return info; }
lapack_int LAPACKE_spteqr_work( int matrix_layout, char compz, lapack_int n, float* d, float* e, float* z, lapack_int ldz, float* work ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_spteqr( &compz, &n, d, e, z, &ldz, work, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldz_t = MAX(1,n); float* z_t = NULL; /* Check leading dimension(s) */ if( ldz < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_spteqr_work", info ); return info; } /* Allocate memory for temporary array(s) */ z_t = (float*)LAPACKE_malloc( sizeof(float) * ldz_t * MAX(1,n) ); if( z_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ if( LAPACKE_lsame( compz, 'v' ) ) { LAPACKE_sge_trans( matrix_layout, n, n, z, ldz, z_t, ldz_t ); } /* Call LAPACK function and adjust info */ LAPACK_spteqr( &compz, &n, d, e, z_t, &ldz_t, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, z_t, ldz_t, z, ldz ); /* Release memory and exit */ LAPACKE_free( z_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_spteqr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_spteqr_work", info ); } return info; }
lapack_int LAPACKE_clacp2_work( int matrix_layout, char uplo, lapack_int m, lapack_int n, const float* a, lapack_int lda, lapack_complex_float* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_clacp2( &uplo, &m, &n, a, &lda, b, &ldb ); 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,m); float* a_t = NULL; lapack_complex_float* b_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_clacp2_work", info ); return info; } if( ldb < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_clacp2_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; } 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_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_clacp2( &uplo, &m, &n, a_t, &lda_t, b_t, &ldb_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_cge_trans( LAPACK_COL_MAJOR, m, 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_clacp2_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_clacp2_work", info ); } return info; }
lapack_int LAPACKE_ssfrk_work( int matrix_order, char transr, char uplo, char trans, lapack_int n, lapack_int k, float alpha, const float* a, lapack_int lda, float beta, float* c ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ssfrk( &transr, &uplo, &trans, &n, &k, &alpha, a, &lda, &beta, c ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int na = LAPACKE_lsame( trans, 'n' ) ? n : k; lapack_int ka = LAPACKE_lsame( trans, 'n' ) ? k : n; lapack_int lda_t = MAX(1,na); float* a_t = NULL; float* c_t = NULL; /* Check leading dimension(s) */ if( lda < ka ) { info = -9; LAPACKE_xerbla( "LAPACKE_ssfrk_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (float*)LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,ka) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } c_t = (float*) LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( c_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, na, ka, a, lda, a_t, lda_t ); LAPACKE_spf_trans( matrix_order, transr, uplo, n, c, c_t ); /* Call LAPACK function and adjust info */ LAPACK_ssfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t, &beta, c_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_spf_trans( LAPACK_COL_MAJOR, transr, uplo, n, c_t, c ); /* 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_ssfrk_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ssfrk_work", info ); } return info; }
lapack_int LAPACKE_sgeqpf_work( int matrix_layout, lapack_int m, lapack_int n, float* a, lapack_int lda, lapack_int* jpvt, float* tau, float* work ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sgeqpf( &m, &n, a, &lda, jpvt, tau, work, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -5; LAPACKE_xerbla( "LAPACKE_sgeqpf_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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_sgeqpf( &m, &n, a_t, &lda_t, jpvt, tau, work, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sgeqpf_work", info ); } return info; }
lapack_int LAPACKE_slaswp_work( int matrix_layout, lapack_int n, float* a, lapack_int lda, lapack_int k1, lapack_int k2, const lapack_int* ipiv, lapack_int incx ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_slaswp( &n, a, &lda, &k1, &k2, ipiv, &incx ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,lda); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -4; LAPACKE_xerbla( "LAPACKE_slaswp_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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, lda, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_slaswp( &n, a_t, &lda_t, &k1, &k2, ipiv, &incx ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, lda, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_slaswp_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_slaswp_work", info ); } return info; }
lapack_int LAPACKE_stfttr_work( int matrix_order, char transr, char uplo, lapack_int n, const float* arf, float* a, lapack_int lda ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_stfttr( &transr, &uplo, &n, arf, a, &lda, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); float* a_t = NULL; float* arf_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_stfttr_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; } arf_t = (float*) LAPACKE_malloc( sizeof(float) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( arf_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_spf_trans( matrix_order, transr, uplo, n, arf, arf_t ); /* Call LAPACK function and adjust info */ LAPACK_stfttr( &transr, &uplo, &n, arf_t, a_t, &lda_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_t, lda_t, a, lda ); /* Release memory and exit */ LAPACKE_free( arf_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_stfttr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_stfttr_work", info ); } return info; }
void LAPACKE_shs_trans( int matrix_order, lapack_int n, const float *in, lapack_int ldin, float *out, lapack_int ldout ) { if( in == NULL || out == NULL ) return; /* Convert subdiagonal first */ if( matrix_order == LAPACK_COL_MAJOR ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, 1, n-1, &in[1], ldin+1, &out[ldout], ldout+1 ); } else if ( matrix_order == LAPACK_ROW_MAJOR ) { LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n-1, 1, &in[ldin], ldin+1, &out[1], ldout+1 ); } else { return; } /* Convert upper triangular. */ LAPACKE_str_trans( matrix_order, 'u', 'n', n, in, ldin, out, ldout); }
lapack_int LAPACKE_spoequ_work( int matrix_order, lapack_int n, const float* a, lapack_int lda, float* s, float* scond, float* amax ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_spoequ( &n, a, &lda, s, scond, amax, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,n); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -4; LAPACKE_xerbla( "LAPACKE_spoequ_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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, n, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ LAPACK_spoequ( &n, a_t, &lda_t, s, scond, amax, &info ); if( info < 0 ) { info = info - 1; } /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_spoequ_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_spoequ_work", info ); } return info; }
float LAPACKE_slange_work( int matrix_layout, char norm, lapack_int m, lapack_int n, const float* a, lapack_int lda, float* work ) { lapack_int info = 0; float res = 0.; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ res = LAPACK_slange( &norm, &m, &n, a, &lda, work ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int lda_t = MAX(1,m); float* a_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_slange_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; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, m, n, a, lda, a_t, lda_t ); /* Call LAPACK function and adjust info */ res = LAPACK_slange( &norm, &m, &n, a_t, &lda_t, work ); info = 0; /* LAPACK call is ok! */ /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_slange_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_slange_work", info ); } return res; }
int main(void) { /* Local scalars */ char uplo, uplo_i; char trans, trans_i; char diag, diag_i; lapack_int n, n_i; lapack_int nrhs, nrhs_i; lapack_int ldb, ldb_i; lapack_int ldb_r; lapack_int ldx, ldx_i; lapack_int ldx_r; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ float *ap = NULL, *ap_i = NULL; float *b = NULL, *b_i = NULL; float *x = NULL, *x_i = NULL; float *ferr = NULL, *ferr_i = NULL; float *berr = NULL, *berr_i = NULL; float *work = NULL, *work_i = NULL; lapack_int *iwork = NULL, *iwork_i = NULL; float *ferr_save = NULL; float *berr_save = NULL; float *ap_r = NULL; float *b_r = NULL; float *x_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_stprfs( &uplo, &trans, &diag, &n, &nrhs, &ldb, &ldx ); ldb_r = nrhs+2; ldx_r = nrhs+2; uplo_i = uplo; trans_i = trans; diag_i = diag; n_i = n; nrhs_i = nrhs; ldb_i = ldb; ldx_i = ldx; /* Allocate memory for the LAPACK routine arrays */ ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) ); b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); x = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) ); ferr = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); work = (float *)LAPACKE_malloc( 3*n * sizeof(float) ); iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); /* Allocate memory for the C interface function arrays */ ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) ); b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); x_i = (float *)LAPACKE_malloc( ldx*nrhs * sizeof(float) ); ferr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr_i = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) ); iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); /* Allocate memory for the backup arrays */ ferr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); berr_save = (float *)LAPACKE_malloc( nrhs * sizeof(float) ); /* Allocate memory for the row-major arrays */ ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) ); b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) ); x_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) ); /* Initialize input arrays */ init_ap( (n*(n+1)/2), ap ); init_b( ldb*nrhs, b ); init_x( ldx*nrhs, x ); init_ferr( nrhs, ferr ); init_berr( nrhs, berr ); init_work( 3*n, work ); init_iwork( n, iwork ); /* Backup the ouptut arrays */ for( i = 0; i < nrhs; i++ ) { ferr_save[i] = ferr[i]; } for( i = 0; i < nrhs; i++ ) { berr_save[i] = berr[i]; } /* Call the LAPACK routine */ stprfs_( &uplo, &trans, &diag, &n, &nrhs, ap, b, &ldb, x, &ldx, ferr, berr, work, iwork, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } info_i = LAPACKE_stprfs_work( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i, work_i, iwork_i ); failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to stprfs\n" ); } else { printf( "FAILED: column-major middle-level interface to stprfs\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } info_i = LAPACKE_stprfs( LAPACK_COL_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, ap_i, b_i, ldb_i, x_i, ldx_i, ferr_i, berr_i ); failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to stprfs\n" ); } else { printf( "FAILED: column-major high-level interface to stprfs\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 ); info_i = LAPACKE_stprfs_work( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i, work_i, iwork_i ); failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to stprfs\n" ); } else { printf( "FAILED: row-major middle-level interface to stprfs\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b[i]; } for( i = 0; i < ldx*nrhs; i++ ) { x_i[i] = x[i]; } for( i = 0; i < nrhs; i++ ) { ferr_i[i] = ferr_save[i]; } for( i = 0; i < nrhs; i++ ) { berr_i[i] = berr_save[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } /* Init row_major arrays */ LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, x_i, ldx, x_r, nrhs+2 ); info_i = LAPACKE_stprfs( LAPACK_ROW_MAJOR, uplo_i, trans_i, diag_i, n_i, nrhs_i, ap_r, b_r, ldb_r, x_r, ldx_r, ferr_i, berr_i ); failed = compare_stprfs( ferr, ferr_i, berr, berr_i, info, info_i, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to stprfs\n" ); } else { printf( "FAILED: row-major high-level interface to stprfs\n" ); } /* Release memory */ if( ap != NULL ) { LAPACKE_free( ap ); } if( ap_i != NULL ) { LAPACKE_free( ap_i ); } if( ap_r != NULL ) { LAPACKE_free( ap_r ); } if( b != NULL ) { LAPACKE_free( b ); } if( b_i != NULL ) { LAPACKE_free( b_i ); } if( b_r != NULL ) { LAPACKE_free( b_r ); } if( x != NULL ) { LAPACKE_free( x ); } if( x_i != NULL ) { LAPACKE_free( x_i ); } if( x_r != NULL ) { LAPACKE_free( x_r ); } if( ferr != NULL ) { LAPACKE_free( ferr ); } if( ferr_i != NULL ) { LAPACKE_free( ferr_i ); } if( ferr_save != NULL ) { LAPACKE_free( ferr_save ); } if( berr != NULL ) { LAPACKE_free( berr ); } if( berr_i != NULL ) { LAPACKE_free( berr_i ); } if( berr_save != NULL ) { LAPACKE_free( berr_save ); } if( work != NULL ) { LAPACKE_free( work ); } if( work_i != NULL ) { LAPACKE_free( work_i ); } if( iwork != NULL ) { LAPACKE_free( iwork ); } if( iwork_i != NULL ) { LAPACKE_free( iwork_i ); } return 0; }
lapack_int LAPACKE_cposvxx_work( int matrix_layout, char fact, char uplo, lapack_int n, lapack_int nrhs, lapack_complex_float* a, lapack_int lda, lapack_complex_float* af, lapack_int ldaf, char* equed, float* s, 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_complex_float* work, float* rwork ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_cposvxx( &fact, &uplo, &n, &nrhs, a, &lda, af, &ldaf, equed, s, b, &ldb, x, &ldx, rcond, rpvgrw, berr, &n_err_bnds, err_bnds_norm, err_bnds_comp, &nparams, params, work, rwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == 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_cposvxx_work", info ); return info; } if( ldaf < n ) { info = -9; LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); return info; } if( ldb < nrhs ) { info = -13; LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); return info; } if( ldx < nrhs ) { info = -15; LAPACKE_xerbla( "LAPACKE_cposvxx_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_cpo_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); if( LAPACKE_lsame( fact, 'f' ) ) { LAPACKE_cpo_trans( matrix_layout, uplo, n, af, ldaf, af_t, ldaf_t ); } LAPACKE_cge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_cposvxx( &fact, &uplo, &n, &nrhs, a_t, &lda_t, af_t, &ldaf_t, equed, s, b_t, &ldb_t, x_t, &ldx_t, rcond, rpvgrw, 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 */ if( LAPACKE_lsame( fact, 'e' ) && LAPACKE_lsame( *equed, 'y' ) ) { LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); } if( LAPACKE_lsame( fact, 'e' ) || LAPACKE_lsame( fact, 'n' ) ) { LAPACKE_cpo_trans( LAPACK_COL_MAJOR, uplo, n, af_t, ldaf_t, af, ldaf ); } LAPACKE_cge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); 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, n_err_bnds ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrhs, n_err_bnds, err_bnds_comp_t, nrhs, err_bnds_comp, n_err_bnds ); /* 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_cposvxx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_cposvxx_work", info ); } return info; }
lapack_int LAPACKE_spbtrs_work( int matrix_layout, char uplo, lapack_int n, lapack_int kd, lapack_int nrhs, const float* ab, lapack_int ldab, float* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_spbtrs( &uplo, &n, &kd, &nrhs, ab, &ldab, b, &ldb, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == LAPACK_ROW_MAJOR ) { lapack_int ldab_t = MAX(1,kd+1); lapack_int ldb_t = MAX(1,n); float* ab_t = NULL; float* b_t = NULL; /* Check leading dimension(s) */ if( ldab < n ) { info = -7; LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); return info; } if( ldb < nrhs ) { info = -9; LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) ); if( ab_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } b_t = (float*)LAPACKE_malloc( sizeof(float) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_spb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); LAPACKE_sge_trans( matrix_layout, n, nrhs, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_spbtrs( &uplo, &n, &kd, &nrhs, ab_t, &ldab_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_spbtrs_work", info ); } return info; }
lapack_int LAPACKE_ssbevx_work( int matrix_layout, char jobz, char range, char uplo, lapack_int n, lapack_int kd, float* ab, lapack_int ldab, float* q, lapack_int ldq, 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_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ssbevx( &jobz, &range, &uplo, &n, &kd, ab, &ldab, q, &ldq, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz, work, iwork, ifail, &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 ldab_t = MAX(1,kd+1); lapack_int ldq_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* ab_t = NULL; float* q_t = NULL; float* z_t = NULL; /* Check leading dimension(s) */ if( ldab < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); return info; } if( ldq < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); return info; } /* Allocate memory for temporary array(s) */ ab_t = (float*)LAPACKE_malloc( sizeof(float) * ldab_t * MAX(1,n) ); if( ab_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } if( LAPACKE_lsame( jobz, 'v' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } } 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_2; } } /* Transpose input matrices */ LAPACKE_ssb_trans( matrix_layout, uplo, n, kd, ab, ldab, ab_t, ldab_t ); /* Call LAPACK function and adjust info */ LAPACK_ssbevx( &jobz, &range, &uplo, &n, &kd, ab_t, &ldab_t, q_t, &ldq_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 */ LAPACKE_ssb_trans( LAPACK_COL_MAJOR, uplo, n, kd, ab_t, ldab_t, ab, ldab ); if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } 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_2: if( LAPACKE_lsame( jobz, 'v' ) ) { LAPACKE_free( q_t ); } exit_level_1: LAPACKE_free( ab_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ssbevx_work", info ); } return info; }
lapack_int LAPACKE_sormbr_work( int matrix_layout, char vect, char side, char trans, lapack_int m, lapack_int n, lapack_int k, const float* a, lapack_int lda, const float* tau, float* c, lapack_int ldc, float* work, lapack_int lwork ) { lapack_int info = 0; lapack_int nq, r; lapack_int lda_t, ldc_t; float *a_t = NULL, *c_t = NULL; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sormbr( &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 ) { nq = LAPACKE_lsame( side, 'l' ) ? m : n; r = LAPACKE_lsame( vect, 'q' ) ? nq : MIN(nq,k); lda_t = MAX(1,r); ldc_t = MAX(1,m); /* Check leading dimension(s) */ if( lda < MIN(nq,k) ) { info = -9; LAPACKE_xerbla( "LAPACKE_sormbr_work", info ); return info; } if( ldc < n ) { info = -12; LAPACKE_xerbla( "LAPACKE_sormbr_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_sormbr( &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 = (float*) LAPACKE_malloc( sizeof(float) * lda_t * MAX(1,MIN(nq,k)) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } c_t = (float*)LAPACKE_malloc( sizeof(float) * ldc_t * MAX(1,n) ); if( c_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_layout, r, MIN(nq,k), a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_layout, m, n, c, ldc, c_t, ldc_t ); /* Call LAPACK function and adjust info */ LAPACK_sormbr( &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_sge_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_sormbr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sormbr_work", info ); } return info; }
int main(void) { /* Local scalars */ char uplo, uplo_i; lapack_int n, n_i; lapack_int nrhs, nrhs_i; lapack_int ldb, ldb_i; lapack_int ldb_r; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ float *ap = NULL, *ap_i = NULL; lapack_int *ipiv = NULL, *ipiv_i = NULL; float *b = NULL, *b_i = NULL; float *b_save = NULL; float *ap_r = NULL; float *b_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_ssptrs( &uplo, &n, &nrhs, &ldb ); ldb_r = nrhs+2; uplo_i = uplo; n_i = n; nrhs_i = nrhs; ldb_i = ldb; /* Allocate memory for the LAPACK routine arrays */ ap = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) ); ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); b = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); /* Allocate memory for the C interface function arrays */ ap_i = (float *)LAPACKE_malloc( ((n*(n+1)/2)) * sizeof(float) ); ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); b_i = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); /* Allocate memory for the backup arrays */ b_save = (float *)LAPACKE_malloc( ldb*nrhs * sizeof(float) ); /* Allocate memory for the row-major arrays */ ap_r = (float *)LAPACKE_malloc( n*(n+1)/2 * sizeof(float) ); b_r = (float *)LAPACKE_malloc( n*(nrhs+2) * sizeof(float) ); /* Initialize input arrays */ init_ap( (n*(n+1)/2), ap ); init_ipiv( n, ipiv ); init_b( ldb*nrhs, b ); /* Backup the ouptut arrays */ for( i = 0; i < ldb*nrhs; i++ ) { b_save[i] = b[i]; } /* Call the LAPACK routine */ ssptrs_( &uplo, &n, &nrhs, ap, ipiv, b, &ldb, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } info_i = LAPACKE_ssptrs_work( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i, ipiv_i, b_i, ldb_i ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to ssptrs\n" ); } else { printf( "FAILED: column-major middle-level interface to ssptrs\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } info_i = LAPACKE_ssptrs( LAPACK_COL_MAJOR, uplo_i, n_i, nrhs_i, ap_i, ipiv_i, b_i, ldb_i ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to ssptrs\n" ); } else { printf( "FAILED: column-major high-level interface to ssptrs\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); info_i = LAPACKE_ssptrs_work( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r, ipiv_i, b_r, ldb_r ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to ssptrs\n" ); } else { printf( "FAILED: row-major middle-level interface to ssptrs\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < (n*(n+1)/2); i++ ) { ap_i[i] = ap[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv[i]; } for( i = 0; i < ldb*nrhs; i++ ) { b_i[i] = b_save[i]; } /* Init row_major arrays */ LAPACKE_spp_trans( LAPACK_COL_MAJOR, uplo, n, ap_i, ap_r ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, nrhs, b_i, ldb, b_r, nrhs+2 ); info_i = LAPACKE_ssptrs( LAPACK_ROW_MAJOR, uplo_i, n_i, nrhs_i, ap_r, ipiv_i, b_r, ldb_r ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, nrhs, b_r, nrhs+2, b_i, ldb ); failed = compare_ssptrs( b, b_i, info, info_i, ldb, nrhs ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to ssptrs\n" ); } else { printf( "FAILED: row-major high-level interface to ssptrs\n" ); } /* Release memory */ if( ap != NULL ) { LAPACKE_free( ap ); } if( ap_i != NULL ) { LAPACKE_free( ap_i ); } if( ap_r != NULL ) { LAPACKE_free( ap_r ); } if( ipiv != NULL ) { LAPACKE_free( ipiv ); } if( ipiv_i != NULL ) { LAPACKE_free( ipiv_i ); } if( b != NULL ) { LAPACKE_free( b ); } if( b_i != NULL ) { LAPACKE_free( b_i ); } if( b_r != NULL ) { LAPACKE_free( b_r ); } if( b_save != NULL ) { LAPACKE_free( b_save ); } return 0; }
lapack_int LAPACKE_sstevr_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, 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_sstevr( &jobz, &range, &n, d, e, &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 ldz_t = MAX(1,n); float* z_t = NULL; /* Check leading dimension(s) */ if( ldz < ncols_z ) { info = -15; LAPACKE_xerbla( "LAPACKE_sstevr_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( liwork == -1 || lwork == -1 ) { LAPACK_sstevr( &jobz, &range, &n, d, e, &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) */ 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; } } /* Call LAPACK function and adjust info */ LAPACK_sstevr( &jobz, &range, &n, d, e, &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 */ 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_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_sstevr_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sstevr_work", info ); } return info; }
int main(void) { /* Local scalars */ char uplo, uplo_i; lapack_int n, n_i; lapack_int lda, lda_i; lapack_int lda_r; lapack_int lwork, lwork_i; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ float *a = NULL, *a_i = NULL; lapack_int *ipiv = NULL, *ipiv_i = NULL; float *work = NULL, *work_i = NULL; float *a_save = NULL; lapack_int *ipiv_save = NULL; float *a_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_ssytrf( &uplo, &n, &lda, &lwork ); lda_r = n+2; uplo_i = uplo; n_i = n; lda_i = lda; lwork_i = lwork; /* Allocate memory for the LAPACK routine arrays */ a = (float *)LAPACKE_malloc( lda*n * sizeof(float) ); ipiv = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); work = (float *)LAPACKE_malloc( lwork * sizeof(float) ); /* Allocate memory for the C interface function arrays */ a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) ); ipiv_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); work_i = (float *)LAPACKE_malloc( lwork * sizeof(float) ); /* Allocate memory for the backup arrays */ a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) ); ipiv_save = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); /* Allocate memory for the row-major arrays */ a_r = (float *)LAPACKE_malloc( n*(n+2) * sizeof(float) ); /* Initialize input arrays */ init_a( lda*n, a ); init_ipiv( n, ipiv ); init_work( lwork, work ); /* Backup the ouptut arrays */ for( i = 0; i < lda*n; i++ ) { a_save[i] = a[i]; } for( i = 0; i < n; i++ ) { ipiv_save[i] = ipiv[i]; } /* Call the LAPACK routine */ ssytrf_( &uplo, &n, a, &lda, ipiv, work, &lwork, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a_save[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv_save[i]; } for( i = 0; i < lwork; i++ ) { work_i[i] = work[i]; } info_i = LAPACKE_ssytrf_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i, ipiv_i, work_i, lwork_i ); failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to ssytrf\n" ); } else { printf( "FAILED: column-major middle-level interface to ssytrf\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a_save[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv_save[i]; } for( i = 0; i < lwork; i++ ) { work_i[i] = work[i]; } info_i = LAPACKE_ssytrf( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i, ipiv_i ); failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to ssytrf\n" ); } else { printf( "FAILED: column-major high-level interface to ssytrf\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a_save[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv_save[i]; } for( i = 0; i < lwork; i++ ) { work_i[i] = work[i]; } LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); info_i = LAPACKE_ssytrf_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r, ipiv_i, work_i, lwork_i ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda ); failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to ssytrf\n" ); } else { printf( "FAILED: row-major middle-level interface to ssytrf\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < lda*n; i++ ) { a_i[i] = a_save[i]; } for( i = 0; i < n; i++ ) { ipiv_i[i] = ipiv_save[i]; } for( i = 0; i < lwork; i++ ) { work_i[i] = work[i]; } /* Init row_major arrays */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 ); info_i = LAPACKE_ssytrf( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r, ipiv_i ); LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda ); failed = compare_ssytrf( a, a_i, ipiv, ipiv_i, info, info_i, lda, n ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to ssytrf\n" ); } else { printf( "FAILED: row-major high-level interface to ssytrf\n" ); } /* Release memory */ if( a != NULL ) { LAPACKE_free( a ); } if( a_i != NULL ) { LAPACKE_free( a_i ); } if( a_r != NULL ) { LAPACKE_free( a_r ); } if( a_save != NULL ) { LAPACKE_free( a_save ); } if( ipiv != NULL ) { LAPACKE_free( ipiv ); } if( ipiv_i != NULL ) { LAPACKE_free( ipiv_i ); } if( ipiv_save != NULL ) { LAPACKE_free( ipiv_save ); } if( work != NULL ) { LAPACKE_free( work ); } if( work_i != NULL ) { LAPACKE_free( work_i ); } return 0; }
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; }
lapack_int LAPACKE_sggsvd_work( int matrix_order, char jobu, char jobv, char jobq, lapack_int m, lapack_int n, lapack_int p, lapack_int* k, lapack_int* l, float* a, lapack_int lda, float* b, lapack_int ldb, float* alpha, float* beta, float* u, lapack_int ldu, float* v, lapack_int ldv, float* q, lapack_int ldq, float* work, lapack_int* iwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a, &lda, b, &ldb, alpha, beta, u, &ldu, v, &ldv, q, &ldq, work, iwork, &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,p); lapack_int ldq_t = MAX(1,n); lapack_int ldu_t = MAX(1,m); lapack_int ldv_t = MAX(1,p); float* a_t = NULL; float* b_t = NULL; float* u_t = NULL; float* v_t = NULL; float* q_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -11; LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); return info; } if( ldb < n ) { info = -13; LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); return info; } if( ldq < n ) { info = -21; LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); return info; } if( ldu < m ) { info = -17; LAPACKE_xerbla( "LAPACKE_sggsvd_work", info ); return info; } if( ldv < p ) { info = -19; LAPACKE_xerbla( "LAPACKE_sggsvd_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; } 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( jobu, 'u' ) ) { u_t = (float*)LAPACKE_malloc( sizeof(float) * ldu_t * MAX(1,m) ); if( u_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } if( LAPACKE_lsame( jobv, 'v' ) ) { v_t = (float*)LAPACKE_malloc( sizeof(float) * ldv_t * MAX(1,p) ); if( v_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_3; } } if( LAPACKE_lsame( jobq, 'q' ) ) { q_t = (float*)LAPACKE_malloc( sizeof(float) * ldq_t * MAX(1,n) ); if( q_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_4; } } /* Transpose input matrices */ LAPACKE_sge_trans( matrix_order, m, n, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_order, p, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_sggsvd( &jobu, &jobv, &jobq, &m, &n, &p, k, l, a_t, &lda_t, b_t, &ldb_t, alpha, beta, u_t, &ldu_t, v_t, &ldv_t, q_t, &ldq_t, work, iwork, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, n, a_t, lda_t, a, lda ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, n, b_t, ldb_t, b, ldb ); if( LAPACKE_lsame( jobu, 'u' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, m, m, u_t, ldu_t, u, ldu ); } if( LAPACKE_lsame( jobv, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, p, p, v_t, ldv_t, v, ldv ); } if( LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, q_t, ldq_t, q, ldq ); } /* Release memory and exit */ if( LAPACKE_lsame( jobq, 'q' ) ) { LAPACKE_free( q_t ); } exit_level_4: if( LAPACKE_lsame( jobv, 'v' ) ) { LAPACKE_free( v_t ); } exit_level_3: if( LAPACKE_lsame( jobu, 'u' ) ) { LAPACKE_free( u_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_sggsvd_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sggsvd_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; }
int main(void) { /* Local scalars */ char uplo, uplo_i; lapack_int n, n_i; lapack_int kd, kd_i; lapack_int ldab, ldab_i; lapack_int ldab_r; float anorm, anorm_i; float rcond, rcond_i; lapack_int info, info_i; lapack_int i; int failed; /* Local arrays */ float *ab = NULL, *ab_i = NULL; float *work = NULL, *work_i = NULL; lapack_int *iwork = NULL, *iwork_i = NULL; float *ab_r = NULL; /* Iniitialize the scalar parameters */ init_scalars_spbcon( &uplo, &n, &kd, &ldab, &anorm ); ldab_r = n+2; uplo_i = uplo; n_i = n; kd_i = kd; ldab_i = ldab; anorm_i = anorm; /* Allocate memory for the LAPACK routine arrays */ ab = (float *)LAPACKE_malloc( ldab*n * sizeof(float) ); work = (float *)LAPACKE_malloc( 3*n * sizeof(float) ); iwork = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); /* Allocate memory for the C interface function arrays */ ab_i = (float *)LAPACKE_malloc( ldab*n * sizeof(float) ); work_i = (float *)LAPACKE_malloc( 3*n * sizeof(float) ); iwork_i = (lapack_int *)LAPACKE_malloc( n * sizeof(lapack_int) ); /* Allocate memory for the row-major arrays */ ab_r = (float *)LAPACKE_malloc( (kd+1)*(n+2) * sizeof(float) ); /* Initialize input arrays */ init_ab( ldab*n, ab ); init_work( 3*n, work ); init_iwork( n, iwork ); /* Call the LAPACK routine */ spbcon_( &uplo, &n, &kd, ab, &ldab, &anorm, &rcond, work, iwork, &info ); /* Initialize input data, call the column-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } info_i = LAPACKE_spbcon_work( LAPACK_COL_MAJOR, uplo_i, n_i, kd_i, ab_i, ldab_i, anorm_i, &rcond_i, work_i, iwork_i ); failed = compare_spbcon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: column-major middle-level interface to spbcon\n" ); } else { printf( "FAILED: column-major middle-level interface to spbcon\n" ); } /* Initialize input data, call the column-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } info_i = LAPACKE_spbcon( LAPACK_COL_MAJOR, uplo_i, n_i, kd_i, ab_i, ldab_i, anorm_i, &rcond_i ); failed = compare_spbcon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: column-major high-level interface to spbcon\n" ); } else { printf( "FAILED: column-major high-level interface to spbcon\n" ); } /* Initialize input data, call the row-major middle-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 ); info_i = LAPACKE_spbcon_work( LAPACK_ROW_MAJOR, uplo_i, n_i, kd_i, ab_r, ldab_r, anorm_i, &rcond_i, work_i, iwork_i ); failed = compare_spbcon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: row-major middle-level interface to spbcon\n" ); } else { printf( "FAILED: row-major middle-level interface to spbcon\n" ); } /* Initialize input data, call the row-major high-level * interface to LAPACK routine and check the results */ for( i = 0; i < ldab*n; i++ ) { ab_i[i] = ab[i]; } for( i = 0; i < 3*n; i++ ) { work_i[i] = work[i]; } for( i = 0; i < n; i++ ) { iwork_i[i] = iwork[i]; } /* Init row_major arrays */ LAPACKE_sge_trans( LAPACK_COL_MAJOR, kd+1, n, ab_i, ldab, ab_r, n+2 ); info_i = LAPACKE_spbcon( LAPACK_ROW_MAJOR, uplo_i, n_i, kd_i, ab_r, ldab_r, anorm_i, &rcond_i ); failed = compare_spbcon( rcond, rcond_i, info, info_i ); if( failed == 0 ) { printf( "PASSED: row-major high-level interface to spbcon\n" ); } else { printf( "FAILED: row-major high-level interface to spbcon\n" ); } /* Release memory */ if( ab != NULL ) { LAPACKE_free( ab ); } if( ab_i != NULL ) { LAPACKE_free( ab_i ); } if( ab_r != NULL ) { LAPACKE_free( ab_r ); } if( work != NULL ) { LAPACKE_free( work ); } if( work_i != NULL ) { LAPACKE_free( work_i ); } if( iwork != NULL ) { LAPACKE_free( iwork ); } if( iwork_i != NULL ) { LAPACKE_free( iwork_i ); } return 0; }
lapack_int LAPACKE_ssygvx_work( int matrix_layout, lapack_int itype, char jobz, char range, char uplo, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, 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 lwork, lapack_int* iwork, lapack_int* ifail ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a, &lda, b, &ldb, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz, work, &lwork, iwork, ifail, &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 ldb_t = MAX(1,n); lapack_int ldz_t = MAX(1,n); float* a_t = NULL; float* b_t = NULL; float* z_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); return info; } if( ldb < n ) { info = -10; LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); return info; } if( ldz < ncols_z ) { info = -19; LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a, &lda_t, b, &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z, &ldz_t, work, &lwork, iwork, ifail, &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( 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_2; } } /* Transpose input matrices */ LAPACKE_ssy_trans( matrix_layout, uplo, n, a, lda, a_t, lda_t ); LAPACKE_sge_trans( matrix_layout, n, n, b, ldb, b_t, ldb_t ); /* Call LAPACK function and adjust info */ LAPACK_ssygvx( &itype, &jobz, &range, &uplo, &n, a_t, &lda_t, b_t, &ldb_t, &vl, &vu, &il, &iu, &abstol, m, w, z_t, &ldz_t, work, &lwork, iwork, ifail, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_ssy_trans( LAPACK_COL_MAJOR, uplo, n, a_t, lda_t, a, lda ); LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, b_t, ldb_t, b, ldb ); 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_2: LAPACKE_free( b_t ); exit_level_1: LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_ssygvx_work", info ); } return info; }
lapack_int LAPACKE_sggev_work( int matrix_order, char jobvl, char jobvr, lapack_int n, float* a, lapack_int lda, float* b, lapack_int ldb, float* alphar, float* alphai, float* beta, float* vl, lapack_int ldvl, float* vr, lapack_int ldvr, float* work, lapack_int lwork ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_sggev( &jobvl, &jobvr, &n, a, &lda, b, &ldb, alphar, alphai, beta, vl, &ldvl, vr, &ldvr, work, &lwork, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int nrows_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; lapack_int ncols_vl = LAPACKE_lsame( jobvl, 'v' ) ? n : 1; lapack_int nrows_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; lapack_int ncols_vr = LAPACKE_lsame( jobvr, 'v' ) ? n : 1; lapack_int lda_t = MAX(1,n); lapack_int ldb_t = MAX(1,n); lapack_int ldvl_t = MAX(1,nrows_vl); lapack_int ldvr_t = MAX(1,nrows_vr); float* a_t = NULL; float* b_t = NULL; float* vl_t = NULL; float* vr_t = NULL; /* Check leading dimension(s) */ if( lda < n ) { info = -6; LAPACKE_xerbla( "LAPACKE_sggev_work", info ); return info; } if( ldb < n ) { info = -8; LAPACKE_xerbla( "LAPACKE_sggev_work", info ); return info; } if( ldvl < ncols_vl ) { info = -13; LAPACKE_xerbla( "LAPACKE_sggev_work", info ); return info; } if( ldvr < ncols_vr ) { info = -15; LAPACKE_xerbla( "LAPACKE_sggev_work", info ); return info; } /* Query optimal working array(s) size if requested */ if( lwork == -1 ) { LAPACK_sggev( &jobvl, &jobvr, &n, a, &lda_t, b, &ldb_t, alphar, alphai, beta, vl, &ldvl_t, vr, &ldvr_t, 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( LAPACKE_lsame( jobvl, 'v' ) ) { vl_t = (float*) LAPACKE_malloc( sizeof(float) * ldvl_t * MAX(1,ncols_vl) ); if( vl_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_2; } } if( LAPACKE_lsame( jobvr, 'v' ) ) { vr_t = (float*) LAPACKE_malloc( sizeof(float) * ldvr_t * MAX(1,ncols_vr) ); if( vr_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_sggev( &jobvl, &jobvr, &n, a_t, &lda_t, b_t, &ldb_t, alphar, alphai, beta, vl_t, &ldvl_t, vr_t, &ldvr_t, 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( LAPACKE_lsame( jobvl, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vl, ncols_vl, vl_t, ldvl_t, vl, ldvl ); } if( LAPACKE_lsame( jobvr, 'v' ) ) { LAPACKE_sge_trans( LAPACK_COL_MAJOR, nrows_vr, ncols_vr, vr_t, ldvr_t, vr, ldvr ); } /* Release memory and exit */ if( LAPACKE_lsame( jobvr, 'v' ) ) { LAPACKE_free( vr_t ); } exit_level_3: if( LAPACKE_lsame( jobvl, 'v' ) ) { LAPACKE_free( vl_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_sggev_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_sggev_work", info ); } return info; }
void LAPACKE_sgg_trans( int matrix_order, lapack_int m, lapack_int n, const float* in, lapack_int ldin, float* out, lapack_int ldout ) { LAPACKE_sge_trans( matrix_order, m, n, in, ldin, out, ldout ); }