int VU_qrd_f( vsip_mview_f *A, vsip_mview_f *R){ vsip_length N = vsip_mgetrowlength_f(A); vsip_scalar_f r; vsip_stride cvst = vsip_mgetrowstride_f(A); vsip_offset a0o = vsip_mgetoffset_f(A); vsip_offset ao = a0o; vsip_length i,j; vsip_vview_f *a = vsip_mcolview_f(A,0); vsip_vview_f *q = vsip_mcolview_f(A,0); if((a == NULL) || (q == NULL)){ /* failure to create vector view */ vsip_vdestroy_f(a); /* destroy in case one create worked */ vsip_vdestroy_f(q); return 1; /* zero implies success */ } for(i=0; i<N; i++){ vsip_vputoffset_f(a,a0o); vsip_vputoffset_f(q,a0o); vsip_mput_f(R,i,i,(r = sqrt(vsip_vdot_f(q,q)))); if(r == 0){ /* no devide by zero */ vsip_vdestroy_f(a); /* clean up any creates */ vsip_vdestroy_f(q); return 2; /* zero implies success */ } vsip_svmul_f((1./r),q,q); a0o += cvst; for(j=i+1; j<N; j++){ ao += cvst; vsip_vputoffset_f(a,ao); vsip_mput_f(R,i,j,(r = vsip_vdot_f(q,a))); vsip_mput_f(R,j,i,0); /* make sure lower diagonal is initialized to zero */ vsip_vsma_f(q,-r,a,a); } ao = a0o; } vsip_vdestroy_f(a); /* clean up any creates */ vsip_vdestroy_f(q); return 0; /* zero implies success */ }
/* sign function as defined in http://www.netlib.org/lapack/lawnspdf/lawn148.pdf */ static vsip_scalar_f sign_f(vsip_scalar_f a_in) { if(a_in < 0.0) return -1.0; else return 1.0; } /* same */ static void biDiagPhaseToZero_f( svdObj_f *svd) { vsip_mview_f *L = svd->L; vsip_vview_f *d = svd->d; vsip_vview_f *f = svd->f; vsip_mview_f *R = svd->R; vsip_scalar_f eps0 = svd->eps0; vsip_length n_d=vsip_vgetlength_f(d); vsip_length n_f=vsip_vgetlength_f(f); vsip_index i,j; vsip_scalar_f ps; vsip_scalar_f m; vsip_vview_f *l = svd->ls_one; vsip_vview_f *r = svd->rs_one; for(i=0; i<n_d; i++){ ps=vsip_vget_f(d,i); m = vsip_mag_f(ps); ps=sign_f(ps); if(m > eps0){ col_sv_f(L,l,i);vsip_svmul_f(ps,l,l); vsip_vput_f(d,i,m); if (i < n_f) vsip_vput_f(f,i,ps*vsip_vget_f(f,i)); } else { vsip_vput_f(d,i,0.0); } } svdZeroCheckAndSet_f(eps0,d,f); for (i=0; i<n_f-1; i++){ j=i+1; ps = vsip_vget_f(f,i); m = vsip_mag_f(ps); ps=sign_f(ps); col_sv_f(L, l, j);vsip_svmul_f(ps,l,l); row_sv_f(R,r,j);vsip_svmul_f(ps,r,r); vsip_vput_f(f,i,m); vsip_vput_f(f,j,ps * vsip_vget_f(f,j)); } j=n_f; i=j-1; ps=vsip_vget_f(f,i); m=vsip_mag_f(ps); ps=sign_f(ps); vsip_vput_f(f,i,m); col_sv_f(L, l, j);vsip_svmul_f(ps,l,l); row_sv_f(R,r,j);vsip_svmul_f(ps,r,r); } static void phaseCheck_f(svdObj_f *svd) { biDiagPhaseToZero_f(svd); } void houseProd_f(vsip_vview_f *v, vsip_mview_f *A) { vsip_mattr_f a_atr; vsip_vview_f *w; vsip_mview_f *B; vsip_mgetattrib_f(A,&a_atr); B=vsip_mcreate_f(a_atr.col_length,a_atr.row_length,VSIP_ROW,VSIP_MEM_NONE); w = vsip_vcreate_f(a_atr.row_length,VSIP_MEM_NONE); vsip_scalar_f beta = 2.0/vsip_vdot_f(v,v); vsip_vmprod_f(v,A,w); vsip_vouter_f(beta,v,w,B); vsip_msub_f(A,B,A); vsip_valldestroy_f(w); vsip_malldestroy_f(B); } /* need to remove create */ void prodHouse_f(vsip_mview_f *A, vsip_vview_f *v) { vsip_mattr_f a_atr; vsip_vview_f *w; vsip_mview_f *B; vsip_mgetattrib_f(A,&a_atr); B=vsip_mcreate_f(a_atr.col_length,a_atr.row_length,VSIP_ROW,VSIP_MEM_NONE); w = vsip_vcreate_f(a_atr.col_length,VSIP_MEM_NONE); vsip_scalar_f beta = 2.0/vsip_vdot_f(v,v); vsip_mvprod_f(A,v,w); vsip_vouter_f(beta,w,v,B); vsip_msub_f(A,B,A); vsip_valldestroy_f(w); vsip_malldestroy_f(B); } /* need to remove create */