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 info, info_i;
lapack_int i;
int failed;
/* Local arrays */
float *a = NULL, *a_i = NULL;
float *a_save = NULL;
float *a_r = NULL;
/* Iniitialize the scalar parameters */
init_scalars_spotrf( &uplo, &n, &lda );
lda_r = n+2;
uplo_i = uplo;
n_i = n;
lda_i = lda;
/* Allocate memory for the LAPACK routine arrays */
a = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
/* Allocate memory for the C interface function arrays */
a_i = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
/* Allocate memory for the backup arrays */
a_save = (float *)LAPACKE_malloc( lda*n * sizeof(float) );
/* 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 );
/* Backup the ouptut arrays */
for( i = 0; i < lda*n; i++ ) {
a_save[i] = a[i];
}
/* Call the LAPACK routine */
spotrf_( &uplo, &n, a, &lda, &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];
}
info_i = LAPACKE_spotrf_work( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i );
failed = compare_spotrf( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major middle-level interface to spotrf\n" );
} else {
printf( "FAILED: column-major middle-level interface to spotrf\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];
}
info_i = LAPACKE_spotrf( LAPACK_COL_MAJOR, uplo_i, n_i, a_i, lda_i );
failed = compare_spotrf( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: column-major high-level interface to spotrf\n" );
} else {
printf( "FAILED: column-major high-level interface to spotrf\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];
}
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_spotrf_work( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_spotrf( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major middle-level interface to spotrf\n" );
} else {
printf( "FAILED: row-major middle-level interface to spotrf\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];
}
/* Init row_major arrays */
LAPACKE_sge_trans( LAPACK_COL_MAJOR, n, n, a_i, lda, a_r, n+2 );
info_i = LAPACKE_spotrf( LAPACK_ROW_MAJOR, uplo_i, n_i, a_r, lda_r );
LAPACKE_sge_trans( LAPACK_ROW_MAJOR, n, n, a_r, n+2, a_i, lda );
failed = compare_spotrf( a, a_i, info, info_i, lda, n );
if( failed == 0 ) {
printf( "PASSED: row-major high-level interface to spotrf\n" );
} else {
printf( "FAILED: row-major high-level interface to spotrf\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 );
}
return 0;
}
int GaussNewton(
void (*func)(T *x, T *r, int m, int n, void *adata),
void (*jacf)(T *x, T *J, int m, int n, void *adata),
T *x, T *r, T* J, int m, int n, int itmax,
T *opts, /* delta, r_threshold, diff_threshold */
void *adata)
{
PhGUtils::debug("m", m, "n", n);
float delta, R_THRES, DIFF_THRES;
if( opts == NULL ) {
// use default values
delta = 1.0; // step size, default to use standard Newton-Ralphson
R_THRES = 1e-6; DIFF_THRES = 1e-6;
}
else {
delta = opts[0]; R_THRES = opts[1]; DIFF_THRES = opts[2];
}
bool allocateR = false, allocateJ = false;
// residue
if( r == NULL ) {
// allocate space for residue
allocateR = true;
r = new T[n];
memset(r, 0, sizeof(T)*n);
}
T* x0 = new T[m];
memset(x0, 0, sizeof(T)*m);
T* deltaX = new T[m]; // also for Jtr
memset(deltaX, 0, sizeof(T)*m);
cblas_scopy(m, x, 1, deltaX, 1);
T* JtJ = new T[m * m];
memset(JtJ, 0, sizeof(T)*m*m);
// Jacobian
if( J == NULL ) {
allocateJ = true;
J = new T[m * n];
memset(J, 0, sizeof(T)*m*n);
}
// compute initial residue
func(x, r, m, n, adata);
//ofstream fout0("r.txt");
//print2DArray(r, n, 1, fout0);
//fout0.close();
int iters = 0;
//::system("pause");
//printArray(x, m);
//printArray(r, n);
// do iteration
while( (cblas_snrm2(m, deltaX, 1) > DIFF_THRES && cblas_snrm2(n, r, 1) > R_THRES && iters < itmax) || iters < 1 ) {
// compute Jacobian
jacf(x, J, m, n, adata);
// store old value
cblas_scopy(m, x, 1, x0, 1);
//ofstream fout1("J.txt");
//print2DArray(J, n, m, fout1);
//fout1.close();
//::system("pause");
// compute JtJ
cblas_ssyrk (CblasColMajor, CblasUpper, CblasNoTrans, m, n, 1.0, J, m, 0, JtJ, m);
//ofstream fout("JtJ.txt");
//print2DArray(JtJ, m, m, fout);
//fout.close();
// compute Jtr
cblas_sgemv (CblasColMajor, CblasNoTrans, m, n, 1.0, J, m, r, 1, 0, deltaX, 1);
// compute deltaX
LAPACKE_spotrf( LAPACK_COL_MAJOR, 'U', m, JtJ, m );
LAPACKE_spotrs( LAPACK_COL_MAJOR, 'U', m, 1, JtJ, m, deltaX, m );
//ofstream fout2("deltaX.txt");
//printArray(deltaX, m, fout2);
//fout2.close();
// update x
cblas_saxpy(m, -delta, deltaX, 1, x, 1);
// update residue
func(x, r, m, n, adata);
//printArray(x, m);
//system("pause");
iters++;
}
//::system("pause");
// delete workspace
delete[] x0;
delete[] deltaX;
delete[] JtJ;
if( allocateR ){ delete[] r;}
if( allocateJ ){ delete[] J;}
return iters;
}
