void VU_cmprintm_f(char s[],
vsip_cmview_f *X)
{
char format[50];
vsip_length RL = vsip_cmgetrowlength_f(X);
vsip_length CL = vsip_cmgetcollength_f(X);
vsip_length row,col;
vsip_cscalar_f x;
strcpy(format,"(%");
strcat(format,s);
strcat(format,"f %+");
strcat(format,s);
strcat(format,"fi) %s");
printf("[\n");
for(row=0; row<CL; row++){
for(col=0; col<RL; col++){
x=vsip_cmget_f(X,row,col);
printf(format,vsip_real_f(x),
vsip_imag_f(x),
((col==(RL-1)) ? ";" : " "));
}
printf("\n");
}
printf("];\n");
return;
}
void VU_cmfill_f(vsip_cmview_f *X, vsip_cscalar_f a)
{
vsip_length RL = vsip_cmgetrowlength_f(X);
vsip_length CL = vsip_cmgetcollength_f(X);
vsip_length row,col;
for(row=0; row<CL; row++)
for(col=0; col<RL; col++)
vsip_cmput_f(X,row,col,a);
return;
}
void VU_cmconjIP_f(vsip_cmview_f *R)
{
vsip_cvview_f *R_row = vsip_cmrowview_f(R,0);
vsip_length MR = vsip_cmgetcollength_f(R);
vsip_stride Rcs = vsip_cmgetcolstride_f(R);
vsip_offset offset = vsip_cmgetoffset_f(R);
while(MR-- > 1){
vsip_cvconj_f(R_row,R_row);
offset += Rcs;
vsip_cvputoffset_f(R_row,offset);
}vsip_cvconj_f(R_row,R_row);
vsip_cvdestroy_f(R_row);
}
void VU_copu_f(
vsip_cmview_f *A,
vsip_cvview_f *x,
vsip_cvview_f *y)
{
vsip_length m = vsip_cmgetcollength_f(A);
vsip_length n = vsip_cmgetrowlength_f(A);
vsip_length i,j;
vsip_cscalar_f temp;
for(i=0; i<m; i++)
for(j=0; j<n; j++){
temp = vsip_cmul_f(vsip_cvget_f(x,i),vsip_cvget_f(y,j));
vsip_cmput_f(A,i,j,vsip_cadd_f(vsip_cmget_f(A,i,j),temp));
}
return;
}
void VU_cmprint_f(vsip_cmview_f *X)
{
vsip_length RL = vsip_cmgetrowlength_f(X);
vsip_length CL = vsip_cmgetcollength_f(X);
vsip_length row,col;
vsip_cscalar_f x;
printf("[\n");
for(row=0; row<CL; row++){
for(col=0; col<RL; col++){
x=vsip_cmget_f(X,row,col);
printf("(%6.4f %+6.4fi%s ",vsip_real_f(x),vsip_imag_f(x),((col==(RL-1)) ? ");" : ")"));
}
printf("\n");
}
printf("];\n");
return;
}
/* matrix copy by col */
PyObject *cmcopyToListByCol_f(vsip_cmview_f *v){
PyObject *cval;
vsip_length M = vsip_cmgetcollength_f(v);
vsip_length N = vsip_cmgetrowlength_f(v);
PyObject *retval = PyList_New(M);
vsip_index i,j;
for(j=0; j<N; j++){
PyObject *col = PyList_New(M);
for(i=0; i<M; i++){
vsip_cscalar_f x = vsip_cmget_f(v,i,j);
double re = (double)x.r;
double im = (double)x.i;
cval = PyComplex_FromDoubles(re,im);
PyList_SetItem(col,i,cval);
}
PyList_SetItem(retval,j,col);
}
return retval;
}
int main(){vsip_init((void*)0);
{
int i,j, solretval=0;
vsip_cmview_f *A = vsip_cmcreate_f(M,N,VSIP_COL,0);
vsip_cmview_f *X = vsip_cmcreate_f(M,NB,VSIP_ROW,0);
/* Nullify the data-space */
for (i=0; i < vsip_cmgetcollength_f(A); i++)
for(j=0; j < vsip_cmgetrowlength_f(A); j++)
vsip_cmput_f(A,i,j,vsip_cmplx_f(0,0));
for (i=0; i < vsip_cmgetcollength_f(X); i++)
for(j=0; j < vsip_cmgetrowlength_f(X); j++)
vsip_cmput_f(X,i,j,vsip_cmplx_f(0,0));
/* Initialise matrix A */
for (i=0; i<M; i++)
for (j = 0; j < N; j++)
if(i == j)
vsip_cmput_f(A,i,j,vsip_cmplx_f(M+1, 0));
else if(i > j)
vsip_cmput_f(A,i,j, vsip_cmplx_f(1,1));
else if(i < j)
vsip_cmput_f(A,i,j,vsip_cmplx_f(1,-1));
{int i,j;
printf("A matrix\nA = [\n");
for(i=0; i<M; i++)
{
for(j=0; j< N; j++)
printf("%6.2f+%6.2fi%s",
vsip_real_f(vsip_cmget_f(A,i,j)),
vsip_imag_f(vsip_cmget_f(A,i,j)),(j == N-1) ? "":",");
(i == M - 1) ? printf("]\n") : printf(";\n");
}
}
{ int j, k;
vsip_cvview_f *y = NULL;
vsip_cvview_f *x;
vsip_vview_f *yr = NULL, *yi = NULL;
vsip_length L = NB;
vsip_length p = M;
for(k=0; k<L; k++)
{
x = vsip_cmcolview_f(X,k);
for (j=0; j<p; j++)
{
y = vsip_cmrowview_f(A,j);
yr = vsip_vrealview_f(y);
yi = vsip_vimagview_f(y);
vsip_cvput_f(x,j, vsip_cmplx_f((double)(k+1)*(vsip_vsumval_f(yr)),
(double) (k+1)*(vsip_vsumval_f(yi))));
/* vsip_vput_f(x,j,(vsip_vsumval_f(y)));*/
vsip_cvdestroy_f(y);
vsip_vdestroy_f(yr);
vsip_vdestroy_f(yi);
}
vsip_cvdestroy_f(x);
}
}
{int i,j;
printf("rhs matrix\nB = [\n");
for(i=0; i<NN; i++)
{
for(j=0; j<NB; j++)
printf("%7.2f+%7.2fi%s",
vsip_real_f(vsip_cmget_f(X,i,j)),
vsip_imag_f(vsip_cmget_f(X,i,j)),(j == NB-1) ? "":",");
(i == NN - 1) ? printf("]\n") : printf(";\n");
}
}
{vsip_cqr_f* qrAop = vsip_cqrd_create_f(M,N, QOPT);
if(qrAop == NULL) exit(1);
{int i,j;
printf("matrix A after factorisation\n R/Q -- \n");
if(QOPT == VSIP_QRD_SAVEQ1)
{
printf("qrd } returns %i\n",vsip_cqrd_f(qrAop,A));
printf("matrix A after factorisation: skinny Q explicitly\n Q1 = [\n");
for(i= 0; i< M ; i++)
{
for(j=0; j< N; j++)
printf("%8.4f+%8.4fi%s",
vsip_real_f(vsip_cmget_f(A,i,j)),
vsip_imag_f(vsip_cmget_f(A,i,j)),(j == N-1) ? "":",");
(i == M - 1) ? printf("]\n") : printf(";\n");
}
} else if(QOPT == VSIP_QRD_SAVEQ || QOPT == VSIP_QRD_NOSAVEQ)
{
printf("qrd returns %i\n",vsip_cqrd_f(qrAop,A));
printf("matrix A after fact.: R and ");
(QOPT == VSIP_QRD_SAVEQ) ? printf("full Q implicitly\n Q/R = [\n") :
printf("Q not saved -- ignore LT portion. \n R = [\n");
for(i= 0; i<M ; i++)
{
for(j=0; j< N; j++)
printf("%9.5f+%9.5fi%s",
vsip_real_f(vsip_cmget_f(A,i,j)),
vsip_imag_f(vsip_cmget_f(A,i,j)),(j == N-1) ? "":",");
(i == M - 1) ? printf("]\n") : printf(";\n");
}
}
}
if( QPROB == VSIP_LLS)
{
if (QOPT == VSIP_QRD_SAVEQ1 || QOPT == VSIP_QRD_SAVEQ)
{
if((solretval=vsip_cqrsol_f(qrAop, QPROB, X)))
{
printf("WARNING -- Least Squares soln returns %i-- CHECK\n",
solretval);
printf("Upper triang. mat. R, possibly singular\n");
}
else
printf("Least Squares soln returns %i\n", solretval);
}
else
{
printf("Least Squares systems cannot be solved by the NOSAVEQ option -- exiting\n");
exit(1);
}
}
else
{
if((solretval=vsip_cqrsol_f(qrAop,QPROB, X)))
{
printf("Covariance soln returns %i\n",solretval);
printf("Upper triang. mat. R, possibly singular\n");
}
else
printf("Covariance soln returns %i\n",solretval);
}
vsip_cqrd_destroy_f(qrAop);
}
{int i,j;
printf("Soln Matrix\nX = [\n");
for(i=0; i<N; i++)
{
for(j=0; j<NB; j++)
printf("%9.5f+%9.5fi%s",
vsip_real_f(vsip_cmget_f(X,i,j)),
vsip_imag_f(vsip_cmget_f(X,i,j)),(j == NB-1) ? "":",");
(i == N - 1) ? printf("]\n") : printf(";\n");
}
}
vsip_cmalldestroy_f(X);
vsip_cmalldestroy_f(A);
} vsip_finalize((void*)0); return 1;
}
int main(){
int init = vsip_init((void*)0);
int i,j, cholsol_retval,chold_retval;
double t0 = VU_ansi_c_clock(); /* for doing some timeing */
vsip_cscalar_f czero = vsip_cmplx_f((vsip_scalar_f)0.0,(vsip_scalar_f)0.0);
vsip_cmview_f *A = vsip_cmcreate_f(N,N,VSIP_COL,0);
vsip_cmview_f *RU = vsip_cmcreate_f(N,N,VSIP_COL,0);
vsip_cmview_f *RL = vsip_cmcreate_f(N,N,VSIP_COL,0);
vsip_cmview_f *XB = vsip_cmcreate_f(N,M,VSIP_ROW,0);
vsip_cchol_f* chol = vsip_cchold_create_f(UPORLO,N); /* NOTE: UPORLO macro above main() */
/* to make sure we have a valid Positive Symetric define */
/* an upper triangular (RU) with positive pivots and */
/* zero below the main diagonal. */
/* Then initialize RL with hermitian of RU */
/* finally create A as the matrix product of RL and RU */
/* Initialise matrix RU */
/* time this */
t0 = VU_ansi_c_clock();
for (i=0; i<N; i++){
for(j = i; j < N; j++){
#ifdef OBNOXIOUS
/* make up some reasonably obnoxious data */
vsip_scalar_f a = cos(1.5/((j+1)*(i+1)))+sqrt(i*j);
vsip_scalar_f b = (i + j + 1) * cos(M_PI * a);
#else
/* the above was to obnoxious for bigger than about N = 10 */
/* the following works for N > 100 */
vsip_scalar_f a = 1; vsip_scalar_f b = 1;
#endif
if(i == j) /* fill diagonal */
vsip_cmput_f(RU,i,j, vsip_cmplx_f(sqrt(N) + sqrt(i),0));
else { /* fill off diagonal */
vsip_cmput_f(RU,i,j,vsip_cmplx_f(b,a));
vsip_cmput_f(RU,j,i,czero);
}
}
}
/* initialize RL */
vsip_cmherm_f(RU,RL);
#ifdef PRINT
VU_cmprintm_f("7.4",RU);
VU_cmprintm_f("7.4",RL);
#endif
printf("Matrix initialize for RU and RL = %f seconds\n",VU_ansi_c_clock() - t0);
/* initialize A */
/* this step will take a long time so time it */
t0 = VU_ansi_c_clock();
vsip_cmprod_f(RL,RU,A);
#ifdef OBNOXIOUS
for(i=0; i<N; i++){
vsip_cvview_f *aview = vsip_cmrowview_f(A,i);
vsip_cvrsdiv_f(aview,vsip_cmag_f(vsip_cvmeanval_f(aview)),aview);
vsip_cvdestroy_f(aview);
}
#endif
printf("Matrix multiply for initialization of A = %f seconds\n",VU_ansi_c_clock() - t0);
/* print A */
/* we only want to do this if A is something reasonable to print */
/* selected as an option in the make file */
#ifdef PRINT
printf("Matrix A =\n");
VU_cmprintm_f("4.2",A);
fflush(stdout);
#endif
/* initialise rhs */
/* start out with XB = {1,2,3,...,M} */
/* calculate what B must be using A */
/* then solve to see if we get XB back */
{ vsip_index i;
vsip_vview_f *y = vsip_vcreate_f(vsip_cmgetcollength_f(A),VSIP_MEM_NONE);
vsip_vview_f *x_r,*x_i;
vsip_cvview_f *x;
vsip_mview_f *A_r = vsip_mrealview_f(A),
*A_i = vsip_mimagview_f(A);
/* time this */
t0 = VU_ansi_c_clock();
for(i=0; i<M; i++){
vsip_vfill_f((vsip_scalar_f)i+1.0,y);
x = vsip_cmcolview_f(XB,i);
x_r = vsip_vrealview_f(x);
x_i = vsip_vimagview_f(x);
vsip_mvprod_f(A_r,y,x_r);
vsip_mvprod_f(A_i,y,x_i);
vsip_cvdestroy_f(x);
vsip_vdestroy_f(x_r);
vsip_vdestroy_f(x_i);
}
vsip_mdestroy_f(A_r);
vsip_mdestroy_f(A_i);
printf("Matrix init for B = %f seconds\n",VU_ansi_c_clock() - t0);
}
/* print XB */
/* we only want to do this if XB is something reasonable to print */
/* selected as an option in the make file */
#ifdef PRINT
printf("Matrix B = \n");
VU_cmprintm_f("7.4",XB);
fflush(stdout);
#endif
if(chol != NULL){
t0 = VU_ansi_c_clock(); /* we want to time the decomposition */
chold_retval = vsip_cchold_f(chol,A);
printf("time decomp %f\n",VU_ansi_c_clock() - t0);
printf("decompostion returns %d\n",chold_retval);
/* now do the solution */
t0 = VU_ansi_c_clock(); /* we want to time the solution */
cholsol_retval=vsip_ccholsol_f(chol,XB);
printf("time solution %f\n",VU_ansi_c_clock() - t0);
printf("cholsol returns %d\n",cholsol_retval);
/* print XB */
/* we only want to do this if XB is something reasonable to print */
/* selected as an option in the make file; otherwise */
/* we print a single row of XB if the matrix is to large since */
/* M is usally reasonable. Printed as a column vector */
#ifdef PRINT
printf("Matrix X = \n");
VU_cmprintm_f("7.4",XB);
fflush(stdout);
#else
{ /* pick a row in the middle */
vsip_cvview_f *x = vsip_cmrowview_f(XB,N/2);
printf("This output sould be 1,2,...,M\n");
VU_cvprintm_f("7.4",x);
fflush(stdout);
vsip_cvdestroy_f(x);
}
#endif
} else {
printf("failed to create cholesky object \n");
}
vsip_cmalldestroy_f(XB);
vsip_cmalldestroy_f(A);
vsip_cmalldestroy_f(RL);
vsip_cmalldestroy_f(RU);
vsip_cchold_destroy_f(chol);
vsip_finalize((void*)0);
return 1;
}