248 lines
6.3 KiB
C
248 lines
6.3 KiB
C
|
|
|
|
typedef F64 (*func_F64)(F64);
|
|
|
|
function F64
|
|
cos2(F64 x)
|
|
{
|
|
return cos(x)*cos(x);
|
|
}
|
|
|
|
function F64
|
|
gq_integration(F64 a, F64 b, func_F64 func)
|
|
{
|
|
|
|
F64 prefac = 0.5*(b-a);
|
|
F64 gq_sum = 0.0;
|
|
|
|
for(U32 i = 0; i < g_gauss_legendre.order; i++)
|
|
{
|
|
F64 w = g_gauss_legendre.weights[i];
|
|
F64 z = g_gauss_legendre.abscissae[i];
|
|
F64 shift = (z*prefac)+((a+b)*0.5);
|
|
F64 funct_value_at_shift = func(shift);
|
|
gq_sum = gq_sum + prefac*w*funct_value_at_shift;
|
|
}
|
|
|
|
return gq_sum;
|
|
|
|
}
|
|
|
|
function void
|
|
test_gauss_legendre()
|
|
{
|
|
|
|
// Test GL qudrature by integrating cos^2 from 0 to 2pi, it should equal pi.
|
|
{
|
|
ArenaTemp scratch = scratch_get(0,0);
|
|
|
|
F64 pi = 4.0*atan(1.0);
|
|
String8 pi_out = str8_pushf(scratch.arena, "Pi from standard library 4.0*atan(1.0) = %.16f \n", pi);
|
|
LOG(pi_out.str);
|
|
|
|
F64 a = 0.0;
|
|
F64 b = 2.0*pi;
|
|
F64 gq_sum_single_interval = gq_integration(a, b, cos2);
|
|
|
|
String8 out = str8_pushf(scratch.arena, "Integration result for a single interval: %.16f, Reference: %.16f \n", gq_sum_single_interval, pi);
|
|
LOG(out.str);
|
|
|
|
// Test with several smaller intervals instead.
|
|
F64 aa[10] = {0.0};
|
|
F64 bb[10] = {0.0};
|
|
F64 delta = b/10.0;
|
|
for(U32 i = 0; i < 10; i++)
|
|
{
|
|
aa[i] = i*delta;
|
|
bb[i] = (i+1)*delta;
|
|
String8 intervals = str8_pushf(scratch.arena, "%i, a=%f, b=%f \n", i, aa[i], bb[i]);
|
|
LOG(intervals.str);
|
|
}
|
|
|
|
F64 gq_sum_several_intervals = 0.0;
|
|
for(U32 i = 0; i < 10; i++)
|
|
{
|
|
gq_sum_several_intervals += gq_integration(aa[i], bb[i], cos2);
|
|
|
|
}
|
|
|
|
out = str8_pushf(scratch.arena, "Integration result for ten intervals: %.16f, Reference: %.16f \n", gq_sum_several_intervals, pi);
|
|
LOG(out.str);
|
|
|
|
|
|
scratch_release(scratch);
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
function void mkl_things(void)
|
|
{
|
|
|
|
OS_InitReceipt os_receipt = OS_init();
|
|
OS_InitGfxReceipt os_gfx_receipt = OS_gfx_init(os_receipt);
|
|
|
|
Arena *arena = m_make_arena();
|
|
|
|
U32 N = 4;
|
|
Z64 *main_A = PushArray(arena, Z64, N*N);
|
|
main_A[0] = (Z64){-3.84, 2.25};
|
|
main_A[1] = (Z64){-0.66, 0.83};
|
|
main_A[2] = (Z64){-3.99, -4.73};
|
|
main_A[3] = (Z64){ 7.74, 4.18};
|
|
main_A[4] = (Z64){-8.94, -4.75};
|
|
main_A[5] = (Z64){-4.40, -3.82};
|
|
main_A[6] = (Z64){-5.88, -6.60};
|
|
main_A[7] = (Z64){ 3.66, -7.53};
|
|
main_A[8] = (Z64){ 8.95, -6.53};
|
|
main_A[9] = (Z64){-3.50, -4.26};
|
|
main_A[10] = (Z64){-3.36, -0.40};
|
|
main_A[11] = (Z64){ 2.58, 3.60};
|
|
main_A[12] = (Z64){-9.87, 4.82};
|
|
main_A[13] = (Z64){-3.15, 7.36};
|
|
main_A[14] = (Z64){-0.75, 5.23};
|
|
main_A[15] = (Z64){ 4.59, 5.41};
|
|
|
|
LOG("\n\n---- Calling Intel MKL zgeev test (Using Z64 instead of MKL_Complex16 etc) ---- \n\n");
|
|
|
|
{
|
|
S32 n = N, lda = N, ldvl = N, ldvr = N, info, lwork;
|
|
Z64 wkopt;
|
|
Z64 *work;
|
|
|
|
F64 *rwork = PushArray(arena, F64, 2*N);
|
|
Z64 *w = PushArray(arena, Z64, N);
|
|
Z64 *vl = PushArray(arena, Z64, N*N);
|
|
Z64 *vr = PushArray(arena, Z64, N*N);
|
|
Z64 *a = PushArray(arena, Z64, N*N);
|
|
for(U32 j = 0; j < N; j++)
|
|
{
|
|
for(U32 i = 0; i < N; i++)
|
|
{
|
|
U32 index = i*N+j;
|
|
|
|
a[index] = main_A[index];
|
|
}
|
|
|
|
}
|
|
|
|
|
|
/* Executable statements */
|
|
LOG( " ZGEEV Example Program Results\n" );
|
|
/* Query and allocate the optimal workspace */
|
|
lwork = -1;
|
|
zgeev( "Vectors", "Vectors", &n, a, &lda, w, vl, &ldvl, vr, &ldvr,
|
|
&wkopt, &lwork, rwork, &info );
|
|
lwork = (S32)wkopt.re;
|
|
work = (Z64*)malloc( lwork*sizeof(Z64) );
|
|
/* Solve eigenproblem */
|
|
zgeev( "Vectors", "Vectors", &n, a, &lda, w, vl, &ldvl, vr, &ldvr,
|
|
work, &lwork, rwork, &info );
|
|
/* Check for convergence */
|
|
if( info > 0 ) {
|
|
LOG( "The algorithm failed to compute eigenvalues.\n" );
|
|
exit( 1 );
|
|
}
|
|
/* Print eigenvalues */
|
|
print_matrix_Z64( "Eigenvalues", 1, n, w, 1 );
|
|
/* Print left eigenvectors */
|
|
print_matrix_Z64( "Left eigenvectors", n, n, vl, ldvl );
|
|
/* Print right eigenvectors */
|
|
print_matrix_Z64( "Right eigenvectors", n, n, vr, ldvr );
|
|
/* Free workspace */
|
|
free( (void*)work );
|
|
} /* End of ZGEEV Example */
|
|
|
|
|
|
|
|
LOG("\n\n--- End of EntryPoint, exiting program. \n\n");
|
|
}
|
|
|
|
|
|
function void
|
|
test_matrix()
|
|
{
|
|
|
|
Mat_F64 test_mat = mat_F64(5, 5);
|
|
|
|
{
|
|
ArenaTemp scratch = scratch_get(0,0);
|
|
|
|
for(U32 i = 0; i < test_mat.size1; i++)
|
|
{
|
|
for(U32 j = 0; j < test_mat.size2; j++)
|
|
{
|
|
F64 val = i * test_mat.size2 + j;
|
|
mat_F64_set(&test_mat, i, j, val);
|
|
}
|
|
}
|
|
|
|
for(U32 i = 0; i < test_mat.size1; i++)
|
|
{
|
|
for(U32 j = 0; j < test_mat.size2; j++)
|
|
{
|
|
F64 val = mat_F64_get(&test_mat, i, j);
|
|
String8 out_str = str8_pushf(scratch.arena, " %2.2f", val);
|
|
LOG(out_str.str);
|
|
}
|
|
LOG("\n");
|
|
}
|
|
|
|
scratch_release(scratch);
|
|
}
|
|
}
|
|
|
|
|
|
function void
|
|
testing_MKL()
|
|
{
|
|
|
|
test_mkl_zgeev();
|
|
test_mkl_dsyevd();
|
|
|
|
}
|
|
|
|
/* function void */
|
|
/* dgeev_example() */
|
|
/* { */
|
|
/* /1* Locals *1/ */
|
|
/* MKL_INT n = N, lda = LDA, ldvl = LDVL, ldvr = LDVR, info, lwork; */
|
|
/* double wkopt; */
|
|
/* double* work; */
|
|
/* /1* Local arrays *1/ */
|
|
/* double wr[N], wi[N], vl[LDVL*N], vr[LDVR*N]; */
|
|
/* double a[LDA*N] = { */
|
|
/* -1.01, 3.98, 3.30, 4.43, 7.31, */
|
|
/* 0.86, 0.53, 8.26, 4.96, -6.43, */
|
|
/* -4.60, -7.04, -3.89, -7.66, -6.16, */
|
|
/* 3.31, 5.29, 8.20, -7.33, 2.47, */
|
|
/* -4.81, 3.55, -1.51, 6.18, 5.58 */
|
|
/* }; */
|
|
/* /1* Executable statements *1/ */
|
|
/* printf( " DGEEV Example Program Results\n" ); */
|
|
/* /1* Query and allocate the optimal workspace *1/ */
|
|
/* lwork = -1; */
|
|
/* dgeev( "Vectors", "Vectors", &n, a, &lda, wr, wi, vl, &ldvl, vr, &ldvr, */
|
|
/* &wkopt, &lwork, &info ); */
|
|
/* lwork = (MKL_INT)wkopt; */
|
|
/* work = (double*)malloc( lwork*sizeof(double) ); */
|
|
/* /1* Solve eigenproblem *1/ */
|
|
/* dgeev( "Vectors", "Vectors", &n, a, &lda, wr, wi, vl, &ldvl, vr, &ldvr, */
|
|
/* work, &lwork, &info ); */
|
|
/* /1* Check for convergence *1/ */
|
|
/* if( info > 0 ) { */
|
|
/* printf( "The algorithm failed to compute eigenvalues.\n" ); */
|
|
/* exit( 1 ); */
|
|
/* } */
|
|
/* /1* Print eigenvalues *1/ */
|
|
/* print_eigenvalues( "Eigenvalues", n, wr, wi ); */
|
|
/* /1* Print left eigenvectors *1/ */
|
|
/* print_eigenvectors( "Left eigenvectors", n, wi, vl, ldvl ); */
|
|
/* /1* Print right eigenvectors *1/ */
|
|
/* print_eigenvectors( "Right eigenvectors", n, wi, vr, ldvr ); */
|
|
/* /1* Free workspace *1/ */
|
|
/* free( (void*)work ); */
|
|
|
|
/* } */
|