int main(){vsip_init((void*)0);
{
vsip_cscalar_f alpha = vsip_cmplx_f(alpha_r,alpha_i);
vsip_cscalar_f beta = vsip_cmplx_f(beta_r,beta_i);
void VU_cmprint_f(vsip_cmview_f*);
void VU_cmfill_f(vsip_cmview_f*, vsip_cscalar_f);
vsip_cmview_f *A = vsip_cmcreate_f(N,M,VSIP_ROW,0),
*C = vsip_cmcreate_f(N,M,VSIP_ROW,0);
int row, col,i;
for(row=0;row<N;row++) for(col=0;col<M;col++)
vsip_cmput_f(A,row,col,vsip_cmplx_f(row,-col - sqrt(col*row)));
printf("\n A input \n");
VU_cmprint_f(A);
VU_cmfill_f(C,vsip_cmplx_f(0,0));
printf("\n C input \n");
VU_cmprint_f(C);
printf("alpha= %f %+fi, beta= %f %+fi,\n",
alpha_r,alpha_i,
beta_r,beta_i);
{
vsip_mat_op OpA = VSIP_MAT_CONJ;
printf("OpA %i\n",OpA);
for(i=0; i<L; i++){
vsip_cgems_f(alpha,A,OpA,beta,C);
printf("C number %i\n",i); VU_cmprint_f(C);
}
}
vsip_cmalldestroy_f(A);
vsip_cmalldestroy_f(C);
} vsip_finalize((void*)0); return 0;
}
int vsip_cfirflt_f(
vsip_cfir_f *fir,
const vsip_cvview_f *xc,
const vsip_cvview_f *yc)
{
vsip_length nout,k;
vsip_cvview_f xx = *(xc),
yy = *(yc);
vsip_cvview_f H1 = *(fir->h),
H2 = *(fir->h);
vsip_cvview_f *x=&xx,*y=&yy;
vsip_cvview_f *h1=&H1,*h2=&H2;
vsip_offset oinc;
oinc = (vsip_offset)((vsip_stride)fir->D * x->stride);
/* calculate number of terms in y */
nout = (fir->N - fir->p);
nout = ((nout % fir->D) == 0) ? (nout / fir->D ) : (nout / fir->D + 1);
/* do overlap section */
k = 0;
x->length = fir->p + 1;
h1->length = fir->s->length;
h2->length = x->length;
h2->offset = h1->length;
while(x->length < fir->M){
vsip_cscalar_f a = vsip_cvdot_f(h1,fir->s);
vsip_cscalar_f b = vsip_cvdot_f(h2,x);
vsip_cvput_f(y,k++,vsip_cmplx_f(a.r + b.r,a.i + b.i));
x->length += fir->D;
fir->s->length -= fir->D;
fir->s->offset += fir->D;
h1->length = fir->s->length;
h2->length = x->length;
h2->offset = h1->length;
}
x->offset += (x->length - fir->M) * x->stride;
x->length = fir->M;
while(k < nout){ /* do the rest of the pieces */
vsip_cvput_f(y,k++,vsip_cvdot_f(fir->h,x));
x->offset += oinc;
}
{
vsip_stride temp_p = (fir->p % fir->D) - (fir->N % fir->D);
fir->p = ((temp_p < 0) ? (vsip_length)((vsip_stride)fir->D + temp_p) : (vsip_length)temp_p);
}
fir->s->offset = 0;
fir->s->length = (fir->state == VSIP_STATE_SAVE) ? fir->M - 1 - fir->p : fir->M -1;
x->length = fir->s->length;
/* fix by JMA, 31/01/2000, incorrect offset calculation */
/* x->offset = xc->length - fir->s->length; */
x->offset = xc->offset + (xc->length - fir->s->length) * xc->stride;
if((fir->s->length > 0) && (fir->state == VSIP_STATE_SAVE))
VI_cvcopy_f_f(x,fir->s);
if(fir->state == VSIP_STATE_NO_SAVE) {
VI_cvfill_f(vsip_cmplx_f((vsip_scalar_f)0,(vsip_scalar_f)0),fir->s);
fir->p = 0;
}
return k;
}
int main(){vsip_init((void*)0);
{
vsip_cmview_f *A = vsip_cmcreate_f(M,P,VSIP_ROW,0),
*B = vsip_cmcreate_f(N,P,VSIP_ROW,0),
*R = vsip_cmcreate_f(M,N,VSIP_ROW,0);
int i, j;
for(i=0;i<M;i++) for(j=0;j<P;j++)
vsip_cmput_f(A,i,j,vsip_cmplx_f(i,1 + sqrt(i*j)));
for(i=0;i<N;i++) for(j=0;j<P;j++)
vsip_cmput_f(B,i,j,vsip_cmplx_f(1 , i * j));
printf("\n A input \n");
vsip_cmprodh_f(A,B,R);
{for(i=0;i<M;i++) {for(j=0;j<P;j++){
printf(": (%5.2f, %5.2f) ",
vsip_real_f(vsip_cmget_f(A,i,j)),
vsip_imag_f(vsip_cmget_f(A,i,j)));
}
printf(":\n");
}
}
printf("\n B input \n");
{for(i=0;i<N;i++) {for(j=0;j<P;j++){
printf(": (%5.2f, %5.2f) ",
vsip_real_f(vsip_cmget_f(B,i,j)),
vsip_imag_f(vsip_cmget_f(B,i,j)));
}
printf(":\n");
}
}
printf("\n R output \n");
{for(i=0;i<M;i++) {for(j=0;j<N;j++){
printf(": (%5.2f, %5.2f) ",
vsip_real_f(vsip_cmget_f(R,i,j)),
vsip_imag_f(vsip_cmget_f(R,i,j)));
}
printf(":\n");
}
}
vsip_cmalldestroy_f(A);
vsip_cmalldestroy_f(B);
vsip_cmalldestroy_f(R);
} vsip_finalize((void*)0); return 0;
}
void VU_cmprodqh_f(
vsip_cmview_f *C,
vsip_cmview_f *H,
vsip_scalar_f *beta)
{
vsip_cmattr_f attr_C,attr_C0;
vsip_cmattr_f attr_H0;
vsip_cvattr_f attr_h,attr_v0;
vsip_cvview_f *h = vsip_cmcolview_f(H,0);
vsip_length m,n;
vsip_length j;
vsip_stride k;
vsip_cvview_f *v, *w;
vsip_cmgetattrib_f(C,&attr_C);
vsip_cvgetattrib_f(h,&attr_h);
vsip_cmgetattrib_f(H,&attr_H0);
attr_C0 = attr_C;
m = attr_C.col_length;
n = attr_C.row_length;
v = vsip_cvcreate_f(n,0);
vsip_cvgetattrib_f(v,&attr_v0);
w = vsip_cvcreate_f(m,0);
vsip_cvfill_f(vsip_cmplx_f(0,0),v);
for(k= attr_H0.row_length - 1; k >= 0; k--){
j = (vsip_length)k;
attr_h.offset = j * attr_H0.row_stride +
j * attr_H0.col_stride + attr_H0.offset;
attr_h.length = attr_H0.col_length - j;
vsip_cvputlength_f(v,attr_h.length);
vsip_cvputoffset_f(v,n - attr_h.length);
vsip_cvputattrib_f(h,&attr_h);
vsip_cvcopy_f_f(h,v);
vsip_cvput_f(v,0,vsip_cmplx_f(1,0));
vsip_cvputattrib_f(v,&attr_v0);
VU_rscmvprod_f(-beta[j],C,v,w);
VU_copuh_f(C,w,v);
}
vsip_cmputattrib_f(C,&attr_C0);
vsip_cvdestroy_f(h);
vsip_cvalldestroy_f(v);
vsip_cvalldestroy_f(w);
return;
}
int main(){vsip_init((void*)0);
{
vsip_cscalar_f alpha = vsip_cmplx_f(alpha_r,alpha_i),
beta = vsip_cmplx_f(beta_r,beta_i);
void VU_cmprint_f(vsip_cmview_f*);
void VU_cmfill_f(vsip_cmview_f*, vsip_cscalar_f);
vsip_cmview_f *A = vsip_cmcreate_f(N,M,VSIP_ROW,0),
*B = vsip_cmcreate_f(P,M,VSIP_ROW,0),
*C = vsip_cmcreate_f(N,P,VSIP_ROW,0);
int row, col,i;
for(row=0;row<N;row++) for(col=0;col<M;col++)
vsip_cmput_f(A,row,col,vsip_cmplx_f(row,col));
for(row=0;row<P;row++) for(col=0;col<M;col++)
vsip_cmput_f(B,row,col,vsip_cmplx_f(col, -2*row));
printf("\n A input \n");
VU_cmprint_f(A);
printf("\n B input \n");
VU_cmprint_f(B);
VU_cmfill_f(C,vsip_cmplx_f(0,0));
printf("alpha= (%f %+fi), beta= (%f %+fi),\n",
vsip_real_f(alpha),vsip_imag_f(alpha),
vsip_real_f(beta),vsip_imag_f(beta));
{
vsip_mat_op OpA = VSIP_MAT_NTRANS;
vsip_mat_op OpB = VSIP_MAT_HERM;
printf("OpA %i OpB %i\n",OpA,OpB);
for(i=0; i<L; i++){
vsip_cgemp_f(alpha,A,OpA,B,OpB,beta,C);
printf("C number %i\n",i); VU_cmprint_f(C);
}
}
vsip_cmalldestroy_f(A);
vsip_cmalldestroy_f(B);
vsip_cmalldestroy_f(C);
} vsip_finalize((void*)0); return 0;
}
void VU_chouse_f(
vsip_cvview_f *x,
vsip_cvview_f *v,
vsip_scalar_f *beta)
{
vsip_cscalar_f x_1 = vsip_cvget_f(x,0);
vsip_scalar_f x2n = sqrt(vsip_real_f(vsip_cvjdot_f(x,x)));
vsip_scalar_f x_1radius = sqrt(x_1.r * x_1.r + x_1.i * x_1.i);
x_1.r /= x_1radius; x_1.i /= x_1radius;
x_1.r *= x2n; x_1.i *= x2n;
vsip_cvcopy_f_f(x,v);
x_1 = vsip_csub_f(vsip_cvget_f(v,0),x_1);
vsip_csvmul_f(vsip_crecip_f(x_1),v,v);
vsip_cvput_f(v,0,vsip_cmplx_f(1,0));
*beta = 2.0 /vsip_real_f(vsip_cvjdot_f(v,v));
return;
}
vsip_cscalar_f (vsip_cvsumval_f)(
const vsip_cvview_f* a) {
{
/* register */ vsip_length n = a->length;
vsip_stride cast = a->block->cstride;
vsip_scalar_f *apr = (vsip_scalar_f*) ((a->block->R->array) + cast * a->offset);
vsip_scalar_f *api = (vsip_scalar_f*) ((a->block->I->array) + cast * a->offset);
vsip_cscalar_f sum = vsip_cmplx_f(0,0);
/* register */ vsip_stride ast = (cast * a->stride);
while(n-- > 0){
sum.r += *apr;
sum.i += *api;
apr += ast; api += ast;
}
return sum;
}
}
vsip_cscalar_f (vsip_cmsumval_f)(
const vsip_cmview_f *a) {
vsip_cscalar_f retval = vsip_cmplx_f(0.,0.);
{
vsip_length n_mj, /* major length */
n_mn; /* minor length */
vsip_stride ast_mj, ast_mn;
vsip_scalar_f *ap_r = (a->block->R->array) + a->offset * a->block->cstride;
vsip_scalar_f *ap_i = (a->block->I->array) + a->offset * a->block->cstride;
vsip_scalar_f *ap0_r = ap_r;
vsip_scalar_f *ap0_i = ap_i;
/* pick direction dependent on output */
if(a->row_stride < a->col_stride){
n_mj = a->row_length; n_mn = a->col_length;
ast_mj = a->row_stride; ast_mn = a->col_stride;
ast_mj *= a->block->cstride; ast_mn *= a->block->cstride;
} else {
n_mn = a->row_length; n_mj = a->col_length;
ast_mn = a->row_stride; ast_mj = a->col_stride;
ast_mn *= a->block->cstride; ast_mj *= a->block->cstride;
}
/*end define*/
while(n_mn-- > 0){
vsip_length n = n_mj;
while(n-- >0){
retval.r += *ap_r;
retval.i += *ap_i;
ap_r += ast_mj;
ap_i += ast_mj;
}
ap0_r += ast_mn;
ap0_i += ast_mn;
ap_r = ap0_r;
ap_i = ap0_i;
}
}
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 argc, char *argv[]){vsip_init((void*)0);
{ if(argc < 3){
printf("usage\nqrdex M N FileName\n");
exit(1);
}
{ /* get some data */
vsip_length M = (vsip_length)atoi(argv[1]),
N = (vsip_length)atoi(argv[2]);
vsip_cmview_f *A = vsip_cmcreate_f(M,N,VSIP_COL,0),
*Q = vsip_cmcreate_f(M,N,VSIP_ROW,0);
vsip_scalar_f *beta = (vsip_scalar_f*)malloc(N * sizeof(vsip_scalar_f));
FILE *fptr = fopen(argv[3],"r");
VU_cmreadf_f(fptr,A);
fclose(fptr);
vsip_cmcopy_f_f(A,Q);
printf("input matrix A \n");
printf("A =");VU_cmprintm_f("6.4",A);
VU_chouseqr_f(Q,beta); /* make a QR matrix, keep the betas */
printf("Decomposed A with R in upper, \n");
printf("and householder vector in lower \n");
printf("householder value on diagonal is 1\n");
printf("v(2:m)\\R =");VU_cmprintm_f("6.4",Q);
{ /* Multiply Q times R to see if we get A */
vsip_length i,j;
vsip_cmview_f *R = vsip_cmcreate_f(M,N,VSIP_ROW,0);
vsip_cvview_f *r = vsip_cmrowview_f(R,0);
vsip_cvputlength_f(r,N * M);
vsip_cvfill_f(vsip_cmplx_f(0,0),r);
for(i=0; i<N; i++) /* extract R */
for(j = i; j<N; j++)
vsip_cmput_f(R,i,j,vsip_cmget_f(Q,i,j));
VU_cqprodm_f(R,Q,beta); /* Q * R */
printf("Multiply Q times R and see if we get A\n");
printf("QR = \n"); VU_cmprintm_f("6.4",R);
vsip_cvdestroy_f(r);
vsip_cmalldestroy_f(R);
}
{ /* Multiply I * Q to get Q */
vsip_cmview_f *I = vsip_cmcreate_f(M,M,VSIP_ROW,0);
vsip_cvview_f *I_rv = vsip_cmrowview_f(I,0);
vsip_cvputlength_f(I_rv,M * M);
vsip_cvfill_f(vsip_cmplx_f(0.0,0.0),I_rv);
vsip_cvputlength_f(I_rv,M);
vsip_cvputstride_f(I_rv,M+1);
vsip_cvfill_f(vsip_cmplx_f(1.0,0.0),I_rv);
printf("Using an Identity matrix extract Q using Householdoer update\n");
printf("I = \n"); VU_cmprintm_f("6.4",I);
VU_cqprodm_f(I,Q,beta);
printf("Q = \n"); VU_cmprintm_f("6.4",I);
{ /* Multiply Q hermitian * A to get R */
vsip_cmview_f *AC = vsip_cmcreate_f(M,N,VSIP_COL,0);
vsip_cmview_f *QT = vsip_cmtransview_f(I);
vsip_cmview_f *R = vsip_cmcreate_f(M,N,VSIP_ROW,0);
vsip_cmprodj_f(QT,A,R);
VU_cmconjIP_f(R);
printf("Using Q from above mutiply Hermitian(Q) times A to get R\n");
printf("QT * A = R = \n"); VU_cmprintm_f("6.4",R);
vsip_cmcopy_f_f(A,AC);
printf("Using Householder update multiply Transpose(Q) times A to get R\n");
VU_cqhprodm_f(AC,Q,beta);
printf("QT * AC = R = \n"); VU_cmprintm_f("6.4",AC);
{ vsip_cmview_f *QTQ = vsip_cmcreate_f(M,M,VSIP_ROW,0);
vsip_cmprodj_f(QT,I,QTQ);
printf("QT * Q = I = \n"); VU_cmprintm_f("6.4",QTQ);
vsip_cmalldestroy_f(QTQ);
}
vsip_cmdestroy_f(QT);
vsip_cmalldestroy_f(R);
}
{
/* general Multiply */
vsip_cmview_f *J = vsip_cmcreate_f(M,2 * M,VSIP_ROW,0);
vsip_cmview_f *K = vsip_cmcreate_f(M,2 * M,VSIP_ROW,0);
vsip_cvview_f *J_rv = vsip_cmrowview_f(J,0);
vsip_cvputlength_f(J_rv,2 * M * M);
vsip_cvfill_f(vsip_cmplx_f(2.0,-1.0),J_rv);
vsip_cvputlength_f(J_rv,M);
vsip_cvputstride_f(J_rv,2 * M+1);
vsip_cvfill_f(vsip_cmplx_f(1.0,1.0),J_rv);
vsip_cvputoffset_f(J_rv,M);
vsip_cvfill_f(vsip_cmplx_f(3.0,0.0),J_rv);
printf("Make a big matrix J to test with \n");
printf("J = \n"); VU_cmprintm_f("6.4",J);
vsip_cmprod_f(I,J,K);
VU_cqprodm_f(J,Q,beta);
printf("Multiply Q * J using Householder update \n");
printf("J = \n"); VU_cmprintm_f("6.4",J);
printf("Multiply Q * J using Q extracted above \n");
printf("K = \n"); VU_cmprintm_f("6.4",K);
printf("\n");
{ vsip_cmview_f *JT = vsip_cmtransview_f(J);
vsip_cmview_f *KT = vsip_cmtransview_f(K);
VU_cmconjIP_f(JT);
printf("Conjugate Transpose the current J (overwritten by the above operation\n");
printf("JT = \n"); VU_cmprintm_f("6.4",JT);
vsip_cmprod_f(JT,I,KT);
VU_cmprodq_f(JT,Q,beta);
printf("Multiply hermitian(J) * Q using Householder update \n");
printf("JT = \n"); VU_cmprintm_f("6.4",JT);
printf("Multiply hermitian(J) * Q using Q extracted above \n");
printf("KT = \n"); VU_cmprintm_f("6.4",KT);
vsip_cmdestroy_f(JT);
vsip_cmdestroy_f(KT);
}
{ vsip_cmview_f *QT = vsip_cmtransview_f(I);
VU_cmconjIP_f(QT);
vsip_cmprod_f(QT,J,K);
VU_cqhprodm_f(J,Q,beta);
printf("Transpose JT to J, multiply transpose(Q) * J using Householder\n");
printf("J = \n"); VU_cmprintm_f("6.4",J);
printf("Transpose JT to J, multiply transpose(Q) * J using Q extracted above\n");
printf("K = \n"); VU_cmprintm_f("6.4",K);
{
vsip_cmview_f* JT = vsip_cmtransview_f(J);
vsip_cmview_f* KT = vsip_cmtransview_f(K);
VU_cmconjIP_f(JT);
vsip_cmprod_f(JT,QT,KT);
VU_cmconjIP_f(QT);
printf("Transpose J, Multiply J * transpose(Q) using Q extracted above\n");
printf("K = \n"); VU_cmprintm_f("6.4",KT);
VU_cmprodqh_f(JT,Q,beta);
VU_cmconjIP_f(JT);
printf("Transpose J, Multiply J * transpose(Q) using Householder\n");
printf("J = \n"); VU_cmprintm_f("6.4",JT);
vsip_cmdestroy_f(JT);
vsip_cmdestroy_f(KT);
}
vsip_cmdestroy_f(QT);
}
{ vsip_cmview_f *I2 = vsip_cmcreate_f(M,M,VSIP_ROW,0);
vsip_cmview_f *I2t = vsip_cmtransview_f(I2);
vsip_cmcopy_f_f(I,I2); VU_cmprodqh_f(I2,Q,beta);
printf("test mprodqh QQh =\n"); VU_cmprintm_f("6.4",I2);
vsip_cmcopy_f_f(I,I2);VU_cmconjIP_f(I2);VU_cqprodm_f(I2t,Q,beta);
printf("test qprodm QQh =\n"); VU_cmprintm_f("6.4",I2);
vsip_cmcopy_f_f(I,I2); VU_cqhprodm_f(I2,Q,beta);
printf("test qhprodm QhQ =\n"); VU_cmprintm_f("6.4",I2);
vsip_cmcopy_f_f(I,I2);VU_cmconjIP_f(I2);VU_cmprodq_f(I2t,Q,beta);
printf("test mprodq QhQ =\n"); VU_cmprintm_f("6.4",I2);
vsip_cmdestroy_f(I2t);
vsip_cmalldestroy_f(I2);
}
}
vsip_cvdestroy_f(I_rv);
vsip_cmalldestroy_f(I);
}
vsip_cmalldestroy_f(A);
vsip_cmalldestroy_f(Q);
free(beta);
} vsip_finalize((void*)0); return 0;
}
}
void vsip_ccorrelate1d_f(
const vsip_ccorr1d_f *cor,
vsip_bias bias,
const vsip_cvview_f *h,
const vsip_cvview_f *x,
const vsip_cvview_f *y)
{
vsip_cvview_f xx = *cor->x,
hh = *cor->h;
vsip_cvview_f *xt = &xx,
*ht = &hh;
xt->length = cor->x->length - x->length;
VI_cvfill_f(vsip_cmplx_f((vsip_scalar_f)0,(vsip_scalar_f)0),xt);
xt->offset = xt->length;
xt->length = x->length;
VI_cvcopy_f_f(x,xt);
xt->length = cor->x->length;
xt->offset = 0;
ht->length = cor->h->length - h->length;
ht->offset = h->length;
VI_cvfill_f(vsip_cmplx_f((vsip_scalar_f)0,(vsip_scalar_f)0),ht);
ht->offset = 0;
ht->length = h->length;
VI_cvcopy_f_f(h,ht);
vsip_ccfftip_f(cor->fft,cor->h);
vsip_ccfftip_f(cor->fft,cor->x);
vsip_cvjmul_f(cor->x,cor->h,cor->x);
vsip_cvconj_f(cor->x,cor->x);
vsip_rscvmul_f(1/(vsip_scalar_f)cor->N,cor->x,cor->x);
vsip_ccfftip_f(cor->fft,cor->x);
/* vsip_cvconj_f(cor->x,cor->x); */
switch(cor->support){
case VSIP_SUPPORT_FULL:
xt->offset = xt->length - cor->mn;
xt->length = y->length;
if(bias == VSIP_UNBIASED){
VI_cvunbiasfull_f(cor,xt,y);
} else {
VI_cvcopy_f_f(xt,y);
}
break;
case VSIP_SUPPORT_SAME:
xt->offset = xt->length - cor->mn + (cor->m-1)/2;
xt->length = y->length;
if(bias == VSIP_UNBIASED){
VI_cvunbiassame_f(cor,xt,y);
} else {
VI_cvcopy_f_f(xt,y);
}
break;
case VSIP_SUPPORT_MIN:
xt->offset = xt->length - cor->mn + cor->m - 1;
xt->length = y->length;
if(bias == VSIP_UNBIASED){
vsip_rscvmul_f((vsip_scalar_f)1.0/(vsip_scalar_f)cor->m,xt,y);
} else {
VI_cvcopy_f_f(xt,y);
}
break;
}
return;
}
vsip_cscalar_f (vsip_cadd_f)(
vsip_cscalar_f x, vsip_cscalar_f y) {/* x + y*/
return vsip_cmplx_f(
(vsip_real_f(x) + vsip_real_f(y)),
(vsip_imag_f(x) + vsip_imag_f(y))); }
vsip_cscalar_f (vsip_rect_f)(
vsip_scalar_f r, vsip_scalar_f t) {
return vsip_cmplx_f(r * VSIP_COS_F(t),
r * VSIP_SIN_F(t)); }
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;
}
int main(){vsip_init((void*)0);
{
vsip_cmview_f *A = vsip_cmcreate_f(M,M,VSIP_ROW,0);
vsip_cmview_f *ATA = vsip_cmcreate_f(M,M,VSIP_ROW,0);
vsip_cmview_f *ATB = vsip_cmcreate_f(M,1,VSIP_COL,0);
{ /* store data ; upper trianglar so answers are obvious */
vsip_cmput_f(A,0,0,vsip_cmplx_f(1,0)); vsip_cmput_f(A,0,1,vsip_cmplx_f(2,1));
vsip_cmput_f(A,0,2,vsip_cmplx_f(1,2));vsip_cmput_f(A,0,3,vsip_cmplx_f(1,3));
vsip_cmput_f(A,1,0,vsip_cmplx_f(0,0)); vsip_cmput_f(A,1,1,vsip_cmplx_f(3,0));
vsip_cmput_f(A,1,2,vsip_cmplx_f(0,0));vsip_cmput_f(A,1,3,vsip_cmplx_f(0,1));
vsip_cmput_f(A,2,0,vsip_cmplx_f(0,0)); vsip_cmput_f(A,2,1,vsip_cmplx_f(0,0));
vsip_cmput_f(A,2,2,vsip_cmplx_f(2,0));vsip_cmput_f(A,2,3,vsip_cmplx_f(3,1));
vsip_cmput_f(A,3,0,vsip_cmplx_f(0,0)); vsip_cmput_f(A,3,1,vsip_cmplx_f(0,0));
vsip_cmput_f(A,3,2,vsip_cmplx_f(0,0));vsip_cmput_f(A,3,3,vsip_cmplx_f(1,0));
vsip_cmput_f(ATB,0,0,vsip_cmplx_f(1,0)); vsip_cmput_f(ATB,1,0,vsip_cmplx_f(2,1));
vsip_cmput_f(ATB,2,0,vsip_cmplx_f(1,0)); vsip_cmput_f(ATB,3,0,vsip_cmplx_f(3,1));
}
printf("b = ");VU_cmprintm_f("6.4",ATB);
printf("use upper triangular so Q is I and R is A\n");
printf("A = ");VU_cmprintm_f("6.4",A);
vsip_cmcopy_f_f(A,ATA);
{ /* solve using LUD */
vsip_clu_f* luAop = vsip_clud_create_f(M);
vsip_clud_f(luAop,ATA);
vsip_clusol_f(luAop,VSIP_MAT_HERM,ATB);
printf("solve A x = b\n");
printf("x from LUD = "); VU_cmprintm_f("6.4",ATB);
vsip_clud_destroy_f(luAop);
}
vsip_cmcopy_f_f(A,ATA);
{ /* solve using qrdsolr */
vsip_cqr_f *qrd;
vsip_cmview_f *B = vsip_cmcreate_f(4,1,VSIP_COL,0);
qrd = vsip_cqrd_create_f(4,4,VSIP_QRD_NOSAVEQ);
vsip_cqrd_f(qrd,ATA);
vsip_cmput_f(B,0,0,vsip_cmplx_f(1,0)); vsip_cmput_f(B,1,0,vsip_cmplx_f(2,1));
vsip_cmput_f(B,2,0,vsip_cmplx_f(1,0)); vsip_cmput_f(B,3,0,vsip_cmplx_f(3,1));
vsip_cqrdsolr_f(qrd,VSIP_MAT_HERM,vsip_cmplx_f(1,0),B);
printf("X from qrdsolr NOSAVEQ =");VU_cmprintm_f("6.4",B);
vsip_cqrd_destroy_f(qrd);
}
vsip_cmcopy_f_f(A,ATA);
{ /* solve using qrdsolr */
vsip_cqr_f *qrd;
vsip_cmview_f *B = vsip_cmcreate_f(4,1,VSIP_COL,0);
qrd = vsip_cqrd_create_f(4,4,VSIP_QRD_SAVEQ);
vsip_cqrd_f(qrd,ATA);
vsip_cmput_f(B,0,0,vsip_cmplx_f(1,0)); vsip_cmput_f(B,1,0,vsip_cmplx_f(2,1));
vsip_cmput_f(B,2,0,vsip_cmplx_f(1,0)); vsip_cmput_f(B,3,0,vsip_cmplx_f(3,1));
vsip_cqrdsolr_f(qrd,VSIP_MAT_HERM,vsip_cmplx_f(1,0),B);
printf("X from qrdsolr SAVEQ1 =");VU_cmprintm_f("6.4",B);
vsip_cqrd_destroy_f(qrd);
}
vsip_cmdestroy_f(A);
vsip_cmdestroy_f(ATA);
vsip_cmdestroy_f(ATB);
} vsip_finalize((void*)0); return 0;
}
vsip_cscalar_f (vsip_conj_f)(vsip_cscalar_f x) { /* conj(x) */
return vsip_cmplx_f(vsip_real_f(x),
-(vsip_imag_f(x))); }
