lapack_int LAPACKE_dsfrk_work( int matrix_layout, char transr, char uplo, char trans, lapack_int n, lapack_int k, double alpha, const double* a, lapack_int lda, double beta, double* c ) { lapack_int info = 0; if( matrix_layout == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dsfrk( &transr, &uplo, &trans, &n, &k, &alpha, a, &lda, &beta, c ); if( info < 0 ) { info = info - 1; } } else if( matrix_layout == 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); double* a_t = NULL; double* c_t = NULL; /* Check leading dimension(s) */ if( lda < ka ) { info = -9; LAPACKE_xerbla( "LAPACKE_dsfrk_work", info ); return info; } /* Allocate memory for temporary array(s) */ a_t = (double*)LAPACKE_malloc( sizeof(double) * lda_t * MAX(1,ka) ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } c_t = (double*) LAPACKE_malloc( sizeof(double) * ( 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_dge_trans( matrix_layout, na, ka, a, lda, a_t, lda_t ); LAPACKE_dpf_trans( matrix_layout, transr, uplo, n, c, c_t ); /* Call LAPACK function and adjust info */ LAPACK_dsfrk( &transr, &uplo, &trans, &n, &k, &alpha, a_t, &lda_t, &beta, c_t ); info = 0; /* LAPACK call is ok! */ /* Transpose output matrices */ LAPACKE_dpf_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_dsfrk_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dsfrk_work", info ); } return info; }
lapack_int LAPACKE_dpftrs_work( int matrix_order, char transr, char uplo, lapack_int n, lapack_int nrhs, const double* a, double* b, lapack_int ldb ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dpftrs( &transr, &uplo, &n, &nrhs, a, b, &ldb, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { lapack_int ldb_t = MAX(1,n); double* b_t = NULL; double* a_t = NULL; /* Check leading dimension(s) */ if( ldb < nrhs ) { info = -8; LAPACKE_xerbla( "LAPACKE_dpftrs_work", info ); return info; } /* Allocate memory for temporary array(s) */ b_t = (double*)LAPACKE_malloc( sizeof(double) * ldb_t * MAX(1,nrhs) ); if( b_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } a_t = (double*) LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_1; } /* Transpose input matrices */ LAPACKE_dge_trans( matrix_order, n, nrhs, b, ldb, b_t, ldb_t ); LAPACKE_dpf_trans( matrix_order, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_dpftrs( &transr, &uplo, &n, &nrhs, a_t, b_t, &ldb_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_dge_trans( LAPACK_COL_MAJOR, n, nrhs, b_t, ldb_t, b, ldb ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_1: LAPACKE_free( b_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dpftrs_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dpftrs_work", info ); } return info; }
lapack_int LAPACKE_dpftrf_work( int matrix_order, char transr, char uplo, lapack_int n, double* a ) { lapack_int info = 0; if( matrix_order == LAPACK_COL_MAJOR ) { /* Call LAPACK function and adjust info */ LAPACK_dpftrf( &transr, &uplo, &n, a, &info ); if( info < 0 ) { info = info - 1; } } else if( matrix_order == LAPACK_ROW_MAJOR ) { double* a_t = NULL; /* Allocate memory for temporary array(s) */ a_t = (double*) LAPACKE_malloc( sizeof(double) * ( MAX(1,n) * MAX(2,n+1) ) / 2 ); if( a_t == NULL ) { info = LAPACK_TRANSPOSE_MEMORY_ERROR; goto exit_level_0; } /* Transpose input matrices */ LAPACKE_dpf_trans( matrix_order, transr, uplo, n, a, a_t ); /* Call LAPACK function and adjust info */ LAPACK_dpftrf( &transr, &uplo, &n, a_t, &info ); if( info < 0 ) { info = info - 1; } /* Transpose output matrices */ LAPACKE_dpf_trans( LAPACK_COL_MAJOR, transr, uplo, n, a_t, a ); /* Release memory and exit */ LAPACKE_free( a_t ); exit_level_0: if( info == LAPACK_TRANSPOSE_MEMORY_ERROR ) { LAPACKE_xerbla( "LAPACKE_dpftrf_work", info ); } } else { info = -1; LAPACKE_xerbla( "LAPACKE_dpftrf_work", info ); } return info; }