/* eps0 is a number << maximum singular value */
svd->eps0=mnormFro_f(B)/(vsip_scalar_f)vsip_mgetrowlength_f(B)*1E-10;
bidiag_f(svd);
UmatExtract_f(svd);
VHmatExtract_f(svd);
biDiagPhaseToZero_f(svd);
vsip_vcopy_f_f(diag_sv_f(B,svd->bs,0),svd->d);
vsip_vcopy_f_f(diag_sv_f(B,svd->bs,1),svd->f);
}
static void gtProd_f(vsip_index i, vsip_index j, vsip_scalar_f c,vsip_scalar_f s, svdObj_f* svd)
{
vsip_mview_f* R = svd->Rs;
vsip_vview_f *a1= row_sv_f(R,svd->rs_one, i);
vsip_vview_f *a2= row_sv_f(R,svd->rs_two, j);
vsip_vview_f *a1c=vclone_f(a1,svd->t);
vsip_svmul_f(c,a1c,a1); vsip_vsma_f(a2,s,a1,a1);
vsip_svmul_f(-s,a1c,a1c); vsip_vsma_f(a2,c,a1c,a2);
}
static void prodG_f(svdObj_f* svd,vsip_index i, vsip_index j,vsip_scalar_f c, vsip_scalar_f s)
{
vsip_mview_f* L = svd->Ls;
vsip_vview_f *a1= col_sv_f(L,svd->ls_one,i);
vsip_vview_f *a2= col_sv_f(L,svd->ls_two,j);
vsip_vview_f *a1c=vclone_f(a1,svd->t);
vsip_svmul_f(c,a1c,a1); vsip_vsma_f(a2,s,a1,a1);
vsip_svmul_f(-s,a1c,a1c);vsip_vsma_f(a2,c,a1c,a2);
}
static givensObj_f givensCoef_f(vsip_scalar_f x1, vsip_scalar_f x2)
{
givensObj_f retval;
vsip_scalar_f t = vsip_hypot_f(x1,x2);
if (x2 == 0.0){
retval.c=1.0;retval.s=0.0;retval.r=x1;
} else if (x1 == 0.0) {
retval.c=0.0;retval.s=sign_f(x2);retval.r=t;
}else{
vsip_scalar_f sn = sign_f(x1);
retval.c=vsip_mag_f(x1)/t;retval.s=sn*x2/t; retval.r=sn*t;
}
return retval;
} /* same */
static void zeroCol_f(svdObj_f *svd)
{
vsip_vview_f *d=svd->ds;
vsip_vview_f *f=svd->fs;
vsip_length n = vsip_vgetlength_f(f);
givensObj_f g;
vsip_scalar_f xd,xf,t;
vsip_index i,j,k;
if (n == 1){
xd=vsip_vget_f(d,0);
xf=vsip_vget_f(f,0);
g=givensCoef_f(xd,xf);
vsip_vput_f(d,0,g.r);
vsip_vput_f(f,0,0.0);
gtProd_f(0,1,g.c,g.s,svd);
}else if (n == 2){
xd=vsip_vget_f(d,1);
xf=vsip_vget_f(f,1);
g=givensCoef_f(xd,xf);
vsip_vput_f(d,1,g.r);
vsip_vput_f(f,1,0.0);
xf=vsip_vget_f(f,0);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,0,xf);
gtProd_f(1,2,g.c,g.s,svd);
xd=vsip_vget_f(d,0);
g=givensCoef_f(xd,t);
vsip_vput_f(d,0,g.r);
gtProd_f(0,2,g.c,g.s,svd);
}else{
i=n-1; j=i-1; k=i;
xd=vsip_vget_f(d,i);
xf=vsip_vget_f(f,i);
g=givensCoef_f(xd,xf);
xf=vsip_vget_f(f,j);
vsip_vput_f(f,i,0.0);
vsip_vput_f(d,i,g.r);
t=-xf*g.s; xf*=g.c;
vsip_vput_f(f,j,xf);
gtProd_f(i,k+1,g.c,g.s,svd);
while (i > 1){
i = j; j = i-1;
xd=vsip_vget_f(d,i);
g=givensCoef_f(xd,t);
vsip_vput_f(d,i,g.r);
xf=vsip_vget_f(f,j);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,j,xf);
gtProd_f(i,k+1,g.c,g.s,svd);
}
xd=vsip_vget_f(d,0);
g=givensCoef_f(xd,t);
vsip_vput_f(d,0,g.r);
gtProd_f(0,k+1,g.c,g.s,svd);
}
}
static void zeroRow_f(svdObj_f *svd)
{
vsip_vview_f *d = svd->ds;
vsip_vview_f *f = svd->fs;
vsip_length n = vsip_vgetlength_f(d);
givensObj_f g;
vsip_scalar_f xd,xf,t;
vsip_index i;
xd=vsip_vget_f(d,0);
xf=vsip_vget_f(f,0);
g=givensCoef_f(xd,xf);
if (n == 1){
vsip_vput_f(f,0,0.0);
vsip_vput_f(d,0,g.r);
}else{
vsip_vput_f(f,0,0.0);
vsip_vput_f(d,0,g.r);
xf=vsip_vget_f(f,1);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,1,xf);
prodG_f(svd,1,0,g.c,g.s);
for(i=1; i<n-1; i++){
xd=vsip_vget_f(d,i);
g=givensCoef_f(xd,t);
prodG_f(svd,i+1,0,g.c,g.s);
vsip_vput_f(d,i,g.r);
xf=vsip_vget_f(f,i+1);
t=-xf * g.s; xf *= g.c;
vsip_vput_f(f,i+1,xf);
}
xd=vsip_vget_f(d,n-1);
g=givensCoef_f(xd,t);
vsip_vput_f(d,n-1,g.r);
prodG_f(svd,n,0,g.c,g.s);
}
}
static vsip_scalar_f svdMu_f(vsip_scalar_f d2,vsip_scalar_f f1,vsip_scalar_f d3,vsip_scalar_f f2)
{
vsip_scalar_f mu;
vsip_scalar_f cu=d2 * d2 + f1 * f1;
vsip_scalar_f cl=d3 * d3 + f2 * f2;
vsip_scalar_f cd = d2 * f2;
vsip_scalar_f D = (cu * cl - cd * cd);
vsip_scalar_f T = (cu + cl);
vsip_scalar_f root = vsip_sqrt_f(T*T - 4 * D);
vsip_scalar_f lambda1 = (T + root)/(2.);
vsip_scalar_f lambda2 = (T - root)/(2.);
if(vsip_mag_f(lambda1 - cl) < vsip_mag_f(lambda2 - cl))
mu = lambda1;
else
mu = lambda2;
return mu;
} /* same */
static vsip_index zeroFind_f(vsip_vview_f* d, vsip_scalar_f eps0)
{
vsip_index j = vsip_vgetlength_f(d);
vsip_scalar_f xd=vsip_vget_f(d,j-1);
while(xd > eps0){
if (j > 1){
j -= 1;
xd=vsip_vget_f(d,j-1);
}else{
break;
}
}
if(xd <= eps0)
vsip_vput_f(d,j-1,0.0);
if (j == 1)
j=0;
return j;
} /* same */
static svdCorner svdCorners_f(vsip_vview_f* f)
{
svdCorner crnr;
vsip_index j=vsip_vgetlength_f(f)-1;
vsip_index i;
while((j > 0) && (vsip_vget_f(f,j) == 0.0))
j-=1;
if(j == 0 && vsip_vget_f(f,0) == 0.0){
crnr.i=0;
crnr.j=0;
} else {
i = j;
j += 1;
while((i > 0) && (vsip_vget_f(f,i) != 0.0))
i -= 1;
if((i == 0) && (vsip_vget_f(f,0)== 0.0)){
crnr.i=1;
crnr.j=j+1;
} else if (i==0){
crnr.i=0;
crnr.j=j+1;
} else {
crnr.i=i+1;
crnr.j=j+1;
}
}
return crnr;
} /* same */
static void UmatExtract_f(svdObj_f *svd)
{
vsip_mview_f* B=svd->B;
vsip_mview_f *U=svd->L;
vsip_index i;
vsip_length m = vsip_mgetcollength_f(B);
vsip_length n = vsip_mgetrowlength_f(B);
vsip_mview_f *Bs=svd->Bs;
vsip_mview_f *Us=svd->Ls;
vsip_vview_f *v;
vsip_scalar_f t;
v = col_sv_f(B,svd->bs,0);
if (m > n){
i=n-1;
col_sv_f(msv_f(B,Bs,i,i),v,0);
t=vsip_vget_f(v,0); vsip_vput_f(v,0,1.0);
houseProd_f(v,msv_f(U,Us,i,i));
vsip_vput_f(v,0,t);
}
for(i=n-2; i>0; i--){
col_sv_f(msv_f(B,Bs,i,i),v,0);
t=vsip_vget_f(v,0); vsip_vput_f(v,0,1.0);
houseProd_f(v,msv_f(U,Us,i,i));
vsip_vput_f(v,0,t);
}
col_sv_f(msv_f(B,Bs,0,0),v,0);
t=vsip_vget_f(v,0); vsip_vput_f(v,0,1.0);
houseProd_f(v,msv_f(U,Us,0,0));
vsip_vput_f(v,0,t);
}
static void VHmatExtract_f(svdObj_f *svd)
{
vsip_mview_f*B = svd->B;
vsip_index i,j;
vsip_length n = vsip_mgetrowlength_f(B);
vsip_mview_f *Bs=svd->Bs;
vsip_mview_f *V=svd->R;
vsip_mview_f *Vs=svd->Rs;
vsip_vview_f *v;
vsip_scalar_f t;
if(n < 3)
return;
v = row_sv_f(B,svd->bs,0);
for(i=n-3; i>0; i--){
j=i+1;
row_sv_f(msv_f(B,Bs,i,j),v,0);
t=vsip_vget_f(v,0);vsip_vput_f(v,0,1.0);
prodHouse_f(msv_f(V,Vs,j,j),v);
vsip_vput_f(v,0,t);
}
row_sv_f(msv_f(B,Bs,0,1),v,0);
t=vsip_vget_f(v,0);vsip_vput_f(v,0,1.0);
prodHouse_f(msv_f(V,Vs,1,1),v);
vsip_vput_f(v,0,t);
}
void VU_vfprintxyg_f(char* format,vsip_vview_f* x,
vsip_vview_f* y,char* fname)
{ vsip_length N = vsip_vgetlength_f(y);
vsip_length i;
FILE *of = fopen(fname,"w");
for(i=0; i<N; i++)fprintf(of,
format, vsip_vget_f(x,i),vsip_vget_f(y,i));
fclose(of); return;
}
static void svdZeroCheckAndSet_f(vsip_scalar_f e, vsip_vview_f *b0, vsip_vview_f *b1)
{
vsip_index i;
vsip_length n = vsip_vgetlength_f(b1);
vsip_scalar_f z = 0.0;
for(i=0; i<n; i++){
vsip_scalar_f b = vsip_mag_f(vsip_vget_f(b1,i));
vsip_scalar_f a = e*(vsip_mag_f(vsip_vget_f(b0,i))
+ vsip_mag_f(vsip_vget_f(b0,i+1)));
if( b < a ) vsip_vput_f(b1,i,z);
}
} /* same */
/* $Id: example16.c,v 2.0 2003/02/22 15:27:32 judd Exp $ */
#include<vsip.h>
#define L 20 /* A length*/
int main(){vsip_init((void*)0);
{
vsip_vview_f* a = vsip_vcreate_f(L,0);
vsip_vview_f* b = vsip_vcreate_f(L,0);
vsip_vview_vi* ab_vi = vsip_vcreate_vi(L,0);
vsip_vview_bl* ab_bl= vsip_vcreate_bl(L,0);
int i;
vsip_length N;
/* make up some data */
vsip_vramp_f(0,2 * M_PI/(L-1),a);
vsip_vcos_f(a,b);
/* find out where b is greater than zero */
vsip_vfill_f(0,a);
vsip_vlgt_f(b,a,ab_bl);
/* find the index where b is greater than zero */
if((N = vsip_vindexbool(ab_bl,ab_vi))){
/* make a vector of those points where b is greater than zero*/
vsip_vgather_f(b,ab_vi,vsip_vputlength_f(a,N));
/*print out the results */
printf("Index Value\n");
for(i=0; i<N; i++)
printf("%li %6.3f\n",
vsip_vget_vi(ab_vi,i),
vsip_vget_f(a,i));
}
else{ printf("Zero Length Index");
}
vsip_valldestroy_f(a);
vsip_valldestroy_f(b);
vsip_valldestroy_vi(ab_vi);
vsip_valldestroy_bl(ab_bl);
} vsip_finalize((void*)0); return 0;
}
/* 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);
}
/* eps0 is a number << maximum singular value */
svd->eps0=mnormFro_f(B)/(vsip_scalar_f)vsip_mgetrowlength_f(B)*1E-10;
bidiag_f(svd);
UmatExtract_f(svd);
VHmatExtract_f(svd);
biDiagPhaseToZero_f(svd);
vsip_vcopy_f_f(diag_sv_f(B,svd->bs,0),svd->d);
vsip_vcopy_f_f(diag_sv_f(B,svd->bs,1),svd->f);
}
static void gtProd_f(vsip_index i, vsip_index j, vsip_scalar_f c,vsip_scalar_f s, svdObj_f* svd)
{
vsip_mview_f* R = svd->Rs;
vsip_vview_f *a1= row_sv_f(R,svd->rs_one, i);
vsip_vview_f *a2= row_sv_f(R,svd->rs_two, j);
vsip_vview_f *a1c=vclone_f(a1,svd->t);
vsip_svmul_f(c,a1c,a1); vsip_vsma_f(a2,s,a1,a1);
vsip_svmul_f(-s,a1c,a1c); vsip_vsma_f(a2,c,a1c,a2);
}
static void prodG_f(svdObj_f* svd,vsip_index i, vsip_index j,vsip_scalar_f c, vsip_scalar_f s)
{
vsip_mview_f* L = svd->Ls;
vsip_vview_f *a1= col_sv_f(L,svd->ls_one,i);
vsip_vview_f *a2= col_sv_f(L,svd->ls_two,j);
vsip_vview_f *a1c=vclone_f(a1,svd->t);
vsip_svmul_f(c,a1c,a1); vsip_vsma_f(a2,s,a1,a1);
vsip_svmul_f(-s,a1c,a1c);vsip_vsma_f(a2,c,a1c,a2);
}
static givensObj_f givensCoef_f(vsip_scalar_f x1, vsip_scalar_f x2)
{
givensObj_f retval;
vsip_scalar_f t = vsip_hypot_f(x1,x2);
if (x2 == 0.0){
retval.c=1.0;retval.s=0.0;retval.r=x1;
} else if (x1 == 0.0) {
retval.c=0.0;retval.s=sign_f(x2);retval.r=t;
}else{
vsip_scalar_f sn = sign_f(x1);
retval.c=vsip_mag_f(x1)/t;retval.s=sn*x2/t; retval.r=sn*t;
}
return retval;
} /* same */
static void zeroCol_f(svdObj_f *svd)
{
vsip_vview_f *d=svd->ds;
vsip_vview_f *f=svd->fs;
vsip_length n = vsip_vgetlength_f(f);
givensObj_f g;
vsip_scalar_f xd,xf,t;
vsip_index i,j,k;
if (n == 1){
xd=vsip_vget_f(d,0);
xf=vsip_vget_f(f,0);
g=givensCoef_f(xd,xf);
vsip_vput_f(d,0,g.r);
vsip_vput_f(f,0,0.0);
gtProd_f(0,1,g.c,g.s,svd);
}else if (n == 2){
xd=vsip_vget_f(d,1);
xf=vsip_vget_f(f,1);
g=givensCoef_f(xd,xf);
vsip_vput_f(d,1,g.r);
vsip_vput_f(f,1,0.0);
xf=vsip_vget_f(f,0);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,0,xf);
gtProd_f(1,2,g.c,g.s,svd);
xd=vsip_vget_f(d,0);
g=givensCoef_f(xd,t);
vsip_vput_f(d,0,g.r);
gtProd_f(0,2,g.c,g.s,svd);
}else{
i=n-1; j=i-1; k=i;
xd=vsip_vget_f(d,i);
xf=vsip_vget_f(f,i);
g=givensCoef_f(xd,xf);
xf=vsip_vget_f(f,j);
vsip_vput_f(f,i,0.0);
vsip_vput_f(d,i,g.r);
t=-xf*g.s; xf*=g.c;
vsip_vput_f(f,j,xf);
gtProd_f(i,k+1,g.c,g.s,svd);
while (i > 1){
i = j; j = i-1;
xd=vsip_vget_f(d,i);
g=givensCoef_f(xd,t);
vsip_vput_f(d,i,g.r);
xf=vsip_vget_f(f,j);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,j,xf);
gtProd_f(i,k+1,g.c,g.s,svd);
}
xd=vsip_vget_f(d,0);
g=givensCoef_f(xd,t);
vsip_vput_f(d,0,g.r);
gtProd_f(0,k+1,g.c,g.s,svd);
}
}
static void zeroRow_f(svdObj_f *svd)
{
vsip_vview_f *d = svd->ds;
vsip_vview_f *f = svd->fs;
vsip_length n = vsip_vgetlength_f(d);
givensObj_f g;
vsip_scalar_f xd,xf,t;
vsip_index i;
xd=vsip_vget_f(d,0);
xf=vsip_vget_f(f,0);
g=givensCoef_f(xd,xf);
if (n == 1){
vsip_vput_f(f,0,0.0);
vsip_vput_f(d,0,g.r);
}else{
vsip_vput_f(f,0,0.0);
vsip_vput_f(d,0,g.r);
xf=vsip_vget_f(f,1);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,1,xf);
prodG_f(svd,1,0,g.c,g.s);
for(i=1; i<n-1; i++){
xd=vsip_vget_f(d,i);
g=givensCoef_f(xd,t);
prodG_f(svd,i+1,0,g.c,g.s);
vsip_vput_f(d,i,g.r);
xf=vsip_vget_f(f,i+1);
t=-xf * g.s; xf *= g.c;
vsip_vput_f(f,i+1,xf);
}
xd=vsip_vget_f(d,n-1);
g=givensCoef_f(xd,t);
vsip_vput_f(d,n-1,g.r);
prodG_f(svd,n,0,g.c,g.s);
}
}
static vsip_scalar_f svdMu_f(vsip_scalar_f d2,vsip_scalar_f f1,vsip_scalar_f d3,vsip_scalar_f f2)
{
vsip_scalar_f mu;
vsip_scalar_f cu=d2 * d2 + f1 * f1;
vsip_scalar_f cl=d3 * d3 + f2 * f2;
vsip_scalar_f cd = d2 * f2;
vsip_scalar_f D = (cu * cl - cd * cd);
vsip_scalar_f T = (cu + cl);
vsip_scalar_f root = vsip_sqrt_f(T*T - 4 * D);
vsip_scalar_f lambda1 = (T + root)/(2.);
vsip_scalar_f lambda2 = (T - root)/(2.);
if(vsip_mag_f(lambda1 - cl) < vsip_mag_f(lambda2 - cl))
mu = lambda1;
else
mu = lambda2;
return mu;
} /* same */
static vsip_index zeroFind_f(vsip_vview_f* d, vsip_scalar_f eps0)
{
vsip_index j = vsip_vgetlength_f(d);
vsip_scalar_f xd=vsip_vget_f(d,j-1);
while(xd > eps0){
if (j > 1){
j -= 1;
xd=vsip_vget_f(d,j-1);
}else{
break;
}
}
if(xd <= eps0)
vsip_vput_f(d,j-1,0.0);
if (j == 1)
j=0;
return j;
} /* same */
PyObject *vcopyToList_f(vsip_vview_f *v){
vsip_length N = vsip_vgetlength_f(v);
PyObject *retval = PyList_New(N);
vsip_index i;
for(i=0; i<N; i++){
double x = (double)vsip_vget_f(v,i);
PyList_SetItem(retval,i,PyFloat_FromDouble(x));
}
return retval;
}
/* 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 */
static vsip_vview_f *houseVector_f(vsip_vview_f* x)
{
vsip_scalar_f nrm=vnorm2_f(x);
vsip_scalar_f t = vsip_vget_f(x,0);
vsip_scalar_f s = t + sign_f(t) * nrm;
vsip_vput_f(x,0,s);
nrm = vnorm2_f(x);
if (nrm == 0.0)
vsip_vput_f(x,0,1.0);
else
vsip_svmul_f(1.0/nrm,x,x);
return x;
}
int main(){vsip_init((void*)0);
{
int i,j;
vsip_vview_f* a = vsip_vcreate_f(M,0);
vsip_vview_f* b = vsip_vcreate_f(N,0);
vsip_mview_f* r = vsip_mcreate_f(
vsip_vgetlength_f(a),
vsip_vgetlength_f(b),
VSIP_ROW,0);
vsip_vramp_f(1.0, 1.0 , b);
vsip_vramp_f(1.0, -2.0/(double)(N-1), a);
vsip_vouter_f(1,a, b, r);
printf("a = [\n");
for(i=0; i<vsip_vgetlength_f(a); i++)
printf("%6.3f%s\n", vsip_vget_f(a,i),
(i == vsip_vgetlength_f(a) -1) ? "":";");
printf("]\n");
printf("b = [\n");
for(i=0; i<vsip_vgetlength_f(b); i++)
printf("%6.3f%s\n", vsip_vget_f(b,i),
(i == vsip_vgetlength_f(a) -1) ? "":";");
printf("]\n");
printf("\na * b' = \n");
for(i=0; i<vsip_vgetlength_f(a); i++){
for(j=0; j<vsip_vgetlength_f(b); j++)
printf("%6.3f ",vsip_mget_f(r,i,j));
printf("\n");
}
printf("]\n");
/*destroy the vector views and any associated blocks*/
vsip_valldestroy_f(b);
vsip_valldestroy_f(a);
vsip_malldestroy_f(r);
} vsip_finalize((void*)0); return 0;
}
static void bidiag_f(svdObj_f *svd)
{
vsip_mview_f *B = svd->B;
vsip_mview_f *Bs = svd->Bs;
vsip_length m = vsip_mgetcollength_f(B);
vsip_length n = vsip_mgetrowlength_f(B);
vsip_vview_f *x=col_sv_f(B,svd->bs,0);
vsip_vview_f *v=vclone_f(x,svd->t);
vsip_vview_f *vs = svd->ts;
vsip_index i,j;
for(i=0; i<n-1; i++){
vsip_vputlength_f(v,m-i);
vsip_vcopy_f_f(col_sv_f(msv_f(B,Bs,i,i),x,0),v);
houseVector_f(v);
vsip_svmul_f(1.0/vsip_vget_f(v,0),v,v);
houseProd_f(v,Bs);
vsip_vcopy_f_f(vsv_f(v,vs,1),vsv_f(x,x,1));
if(i < n-2){
j = i+1;
vsip_vputlength_f(v,n-j);
vsip_vcopy_f_f(row_sv_f(msv_f(B,Bs,i,j),x,0),v);
houseVector_f(v);
vsip_svmul_f(1.0/vsip_vget_f(v,0),v,v);
prodHouse_f(Bs,v);
vsip_vcopy_f_f(vsv_f(v,vs,1),vsv_f(x,x,1));
}
}
if(m > n){
i=n-1;
vsip_vputlength_f(v,m-i);
vsip_vcopy_f_f(col_sv_f(msv_f(B,Bs,i,i),x,0),v);
houseVector_f(v);
vsip_svmul_f(1.0/vsip_vget_f(v,0),v,v);
houseProd_f(v,Bs);
vsip_vcopy_f_f(vsv_f(v,vs,1),vsv_f(x,x,1));
}
}
void VU_vprintm_f(char s[],
vsip_vview_f *X)
{
char format[50];
vsip_length L = vsip_vgetlength_f(X);
vsip_index vi;
vsip_scalar_f x;
strcpy(format,"%");
strcat(format,s);
strcat(format,"f %s\n");
printf("[\n");
for(vi=0; vi<L; vi++){
x=vsip_vget_f(X,vi);
printf(format,x,";");
}
printf("];\n");
return;
}
static void svdIteration_f(svdObj_f* svd)
{
vsip_mview_f *L0 = svd->L; vsip_mview_f *L = svd->Ls;
vsip_vview_f *d0 = svd->d; vsip_vview_f *d = svd->ds;
vsip_vview_f *f0 = svd->f; vsip_vview_f *f = svd->fs;
vsip_mview_f *R0 = svd->R; vsip_mview_f *R= svd->Rs;
vsip_scalar_f eps0 = svd->eps0;
vsip_length n;
svdCorner cnr;
vsip_index k;
vsip_length cntr=0;
vsip_length maxcntr=20*vsip_vgetlength_f(d0);
while (cntr++ < maxcntr){
phaseCheck_f(svd);
cnr=svdCorners_f(f0);
if (cnr.j == 0)
break;
ivsv_f(d0,d,cnr.i,cnr.j);
ivsv_f(f0,f,cnr.i,cnr.j-1);
imsv_f(L0,L,0,0,cnr.i,cnr.j);
imsv_f(R0,R,cnr.i,cnr.j,0,0);
n=vsip_vgetlength_f(f);
k=zeroFind_f(d,eps0);
if (k > 0){
if(vsip_vget_f(d,n) == 0.0){
zeroCol_f(svd);
}else{
imsv_f(L,L,0,0,k-1,0);
ivsv_f(d0,d,k,0);
ivsv_f(f0,f,k-1,0);
zeroRow_f(svd);
}
}else{
svdStep_f(svd);
}
}
}
static void zeroRow_f(svdObj_f *svd)
{
vsip_vview_f *d = svd->ds;
vsip_vview_f *f = svd->fs;
vsip_length n = vsip_vgetlength_f(d);
givensObj_f g;
vsip_scalar_f xd,xf,t;
vsip_index i;
xd=vsip_vget_f(d,0);
xf=vsip_vget_f(f,0);
g=givensCoef_f(xd,xf);
if (n == 1){
vsip_vput_f(f,0,0.0);
vsip_vput_f(d,0,g.r);
}else{
vsip_vput_f(f,0,0.0);
vsip_vput_f(d,0,g.r);
xf=vsip_vget_f(f,1);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,1,xf);
prodG_f(svd,1,0,g.c,g.s);
for(i=1; i<n-1; i++){
xd=vsip_vget_f(d,i);
g=givensCoef_f(xd,t);
prodG_f(svd,i+1,0,g.c,g.s);
vsip_vput_f(d,i,g.r);
xf=vsip_vget_f(f,i+1);
t=-xf * g.s; xf *= g.c;
vsip_vput_f(f,i+1,xf);
}
xd=vsip_vget_f(d,n-1);
g=givensCoef_f(xd,t);
vsip_vput_f(d,n-1,g.r);
prodG_f(svd,n,0,g.c,g.s);
}
}
int main () {
vsip_init((void*)0);{
double time0, time_rc=0, time_cr=0;
int i;
/*int k; for(k=0; k<4; k++)*/{
vsip_cvview_f* vectorOut = vsip_cvcreate_f(L/2 + 1,VSIP_MEM_NONE);
vsip_vview_f* vectorIn = vsip_vcreate_f(L,VSIP_MEM_NONE);
vsip_vview_f* ivectorOut = vsip_vcreate_f(L,VSIP_MEM_NONE);
vsip_fft_f* fftplan = vsip_rcfftop_create_f(L,1.0/L,0,VSIP_ALG_SPACE);
vsip_fft_f* ifftplan = vsip_crfftop_create_f(L,(double)(1.0),0,VSIP_ALG_TIME);
char printbuffer[10][40];
/* char printbuffer[L/2][40]; */
vsip_vramp_f(0, 2 * M_PI * F, vectorIn);
vsip_vcos_f(vectorIn,vectorIn);
/* print vectorIn */
/* for(i=0; i<L/2; i++) */
for(i=0; i<10; i++)
sprintf(printbuffer[i],"%2d, %2d input-> %7.3f, %7.3f",
i, i+L/2, vsip_vget_f(vectorIn,i), vsip_vget_f(vectorIn,i+L/2));
/*find the fft*/
for(i=0; i<N; i++){
/* printf("%d\n",i);fflush(stdout); */
time0=VU_ansi_c_clock();
vsip_rcfftop_f(fftplan,vectorIn,vectorOut);
time_rc += (VU_ansi_c_clock() - time0);
/*find the inverse fft*/
time0=VU_ansi_c_clock();
vsip_crfftop_f(ifftplan,vectorOut,ivectorOut);
time_cr += (VU_ansi_c_clock() - time0);
}
/*print it */
/* for(i=0; i<L/2; i++) */
for(i=0; i<10; i++)
printf("%s fft -> (%9.4f, %9.4f) ifft-> %7.3f, %7.3f\n" ,
printbuffer[i],
vsip_real_f(vsip_cvget_f(vectorOut,i)),
vsip_imag_f(vsip_cvget_f(vectorOut,i)),
vsip_vget_f(ivectorOut,i),
vsip_vget_f(ivectorOut,i+L/2));
printf(" fft -> (%9.4f, %9.4f)\n",
vsip_real_f(vsip_cvget_f(vectorOut,i)),
vsip_imag_f(vsip_cvget_f(vectorOut,i)));
{/* test vsip_fft_getattr_f */
vsip_fft_attr_f attr;
vsip_fft_getattr_f(fftplan, &attr);
printf("%lu %lu %d %f %d\n",attr.input,attr.output,attr.place,attr.scale,attr.dir);
vsip_fft_getattr_f(ifftplan, &attr);
printf("%lu %lu %d %f %d\n",attr.input,attr.output,attr.place,attr.scale,attr.dir);
}
vsip_cvalldestroy_f(vectorOut);
vsip_valldestroy_f(vectorIn);
vsip_fft_destroy_f(fftplan);
printf("time_rc %f; time_cr %f\n",time_rc/(double)N, time_cr/(double)N);
}
}
vsip_finalize((void*)0);
return 0;
}
static void svdStep_f(svdObj_f *svd)
{
vsip_vview_f *d = svd->ds;
vsip_vview_f *f = svd->fs;
givensObj_f g;
vsip_length n = vsip_vgetlength_f(d);
vsip_scalar_f mu=0.0, x1=0.0, x2=0.0;
vsip_scalar_f t=0.0;
vsip_index i,j,k;
vsip_scalar_f d2,f1,d3,f2;
if(n >= 3){
d2=vsip_vget_f(d,n-2);f1= vsip_vget_f(f,n-3);d3 = vsip_vget_f(d,n-1);f2= vsip_vget_f(f,n-2);
} else if(n == 2){
d2=vsip_vget_f(d,0);f1= 0.0;d3 = vsip_vget_f(d,1);f2= vsip_vget_f(f,0);
} else {
d2=vsip_vget_f(d,0);f1 = 0.0;d3 = 0.0;f2 = 0.0;
}
mu = svdMu_f(d2,f1,d3,f2);
x1=vsip_vget_f(d,0);
x2 = x1 * vsip_vget_f(f,0);
x1 *= x1; x1 -= mu;
g=givensCoef_f(x1,x2);
x1=vsip_vget_f(d,0);x2=vsip_vget_f(f,0);
vsip_vput_f(f,0,g.c * x2 - g.s * x1);
vsip_vput_f(d,0,x1 * g.c + x2 * g.s);
t=vsip_vget_f(d,1); vsip_vput_f(d,1,t*g.c);
t*=g.s;
gtProd_f(0,1,g.c,g.s,svd);
for(i=0; i<n-2; i++){
j=i+1; k=i+2;
g = givensCoef_f(vsip_vget_f(d,i),t);
vsip_vput_f(d,i,g.r);
x1=vsip_vget_f(d,j)*g.c;
x2=vsip_vget_f(f,i)*g.s;
t= x1 - x2;
x1=vsip_vget_f(f,i) * g.c;
x2=vsip_vget_f(d,j) * g.s ;
vsip_vput_f(f,i,x1+x2);
vsip_vput_f(d,j,t);
x1=vsip_vget_f(f,j);
t=g.s * x1;
vsip_vput_f(f,j, x1*g.c);
prodG_f(svd,i, j, g.c, g.s);
g=givensCoef_f(vsip_vget_f(f,i),t);
vsip_vput_f(f,i,g.r);
x1=vsip_vget_f(d,j); x2=vsip_vget_f(f,j);
vsip_vput_f(d,j,g.c * x1 + g.s * x2); vsip_vput_f(f,j,g.c * x2 - g.s * x1);
x1=vsip_vget_f(d,k);
t=g.s * x1; vsip_vput_f(d,k,x1*g.c);
gtProd_f(j,k, g.c, g.s,svd);
}
i=n-2; j=n-1;
g = givensCoef_f(vsip_vget_f(d,i),t);
vsip_vput_f(d,i,g.r);
x1=vsip_vget_f(d,j)*g.c; x2=vsip_vget_f(f,i)*g.s;
t=x1 - x2;
x1 = vsip_vget_f(f,i) * g.c; x2=vsip_vget_f(d,j) * g.s;
vsip_vput_f(f,i,x1+x2);
vsip_vput_f(d,j,t);
prodG_f(svd,i, j, g.c, g.s);
}
static void zeroCol_f(svdObj_f *svd)
{
vsip_vview_f *d=svd->ds;
vsip_vview_f *f=svd->fs;
vsip_length n = vsip_vgetlength_f(f);
givensObj_f g;
vsip_scalar_f xd,xf,t;
vsip_index i,j,k;
if (n == 1){
xd=vsip_vget_f(d,0);
xf=vsip_vget_f(f,0);
g=givensCoef_f(xd,xf);
vsip_vput_f(d,0,g.r);
vsip_vput_f(f,0,0.0);
gtProd_f(0,1,g.c,g.s,svd);
}else if (n == 2){
xd=vsip_vget_f(d,1);
xf=vsip_vget_f(f,1);
g=givensCoef_f(xd,xf);
vsip_vput_f(d,1,g.r);
vsip_vput_f(f,1,0.0);
xf=vsip_vget_f(f,0);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,0,xf);
gtProd_f(1,2,g.c,g.s,svd);
xd=vsip_vget_f(d,0);
g=givensCoef_f(xd,t);
vsip_vput_f(d,0,g.r);
gtProd_f(0,2,g.c,g.s,svd);
}else{
i=n-1; j=i-1; k=i;
xd=vsip_vget_f(d,i);
xf=vsip_vget_f(f,i);
g=givensCoef_f(xd,xf);
xf=vsip_vget_f(f,j);
vsip_vput_f(f,i,0.0);
vsip_vput_f(d,i,g.r);
t=-xf*g.s; xf*=g.c;
vsip_vput_f(f,j,xf);
gtProd_f(i,k+1,g.c,g.s,svd);
while (i > 1){
i = j; j = i-1;
xd=vsip_vget_f(d,i);
g=givensCoef_f(xd,t);
vsip_vput_f(d,i,g.r);
xf=vsip_vget_f(f,j);
t= -xf * g.s; xf *= g.c;
vsip_vput_f(f,j,xf);
gtProd_f(i,k+1,g.c,g.s,svd);
}
xd=vsip_vget_f(d,0);
g=givensCoef_f(xd,t);
vsip_vput_f(d,0,g.r);
gtProd_f(0,k+1,g.c,g.s,svd);
}
}
