/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void extractz(scicos_block *block,int flag)
{
double *ur = NULL;
double *ui = NULL;
double *yr = NULL;
double *yi = NULL;
int *r = NULL;
int nu = 0,mu = 0,nr = 0,i = 0,j = 0,ij = 0,k = 0,nc = 0,nl = 0;
mu=GetInPortRows(block,1);
nu=GetInPortCols(block,1);
nr=GetNipar(block);
r=GetIparPtrs(block);
ur=GetRealInPortPtrs(block,1);
ui=GetImagInPortPtrs(block,1);
yr=GetRealOutPortPtrs(block,1);
yi=GetImagOutPortPtrs(block,1);
nc=r[nr-1];
nl=r[nr-2];
k=0;
for (j=0;j<nc;j++)
{for (i=0;i<nl;i++)
{ij=r[i]-1+(r[nl+j]-1)*mu;
*(yr+k)=*(ur+ij);
*(yi+k)=*(ui+ij);
k++;}}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matzmul_m(scicos_block *block, int flag)
{
int mu1 = GetInPortRows(block, 1);
int mu2 = GetInPortRows(block, 2);
int nu = GetInPortCols(block, 2);
double *u1r = GetRealInPortPtrs(block, 1);
double *u1i = GetImagInPortPtrs(block, 1);
double *u2r = GetRealInPortPtrs(block, 2);
double *u2i = GetImagInPortPtrs(block, 2);
double *yr = GetRealOutPortPtrs(block, 1);
double *yi = GetImagOutPortPtrs(block, 1);
C2F(wmmul)(u1r, u1i, &mu1, u2r, u2i, &mu2, yr, yi, &mu1, &mu1, &mu2, &nu);
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matz_conj(scicos_block *block,int flag)
{
int i = 0;
int mu = GetOutPortRows(block,1);
int nu = GetOutPortCols(block,1);
double *u1r = GetRealInPortPtrs(block,1);
double *u1i = GetImagInPortPtrs(block,1);
double *yr = GetRealOutPortPtrs(block,1);
double *yi = GetImagOutPortPtrs(block,1);
for (i=0;i<mu*nu;i++)
{
*(yr+i)=*(u1r+i);
*(yi+i)=-(*(u1i+i));
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matz_reimc(scicos_block *block,int flag)
{
int i = 0;
int mu = GetOutPortRows(block,1);
int nu = GetOutPortCols(block,1);
double *u1 = GetRealInPortPtrs(block,1);
double *u2 = GetRealInPortPtrs(block,2);
double *y1r = GetRealOutPortPtrs(block,1);
double *y1i = GetImagOutPortPtrs(block,1);
for (i=0;i<mu*nu;i++)
{
*(y1r+i)=*(u1+i);
*(y1i+i)=*(u2+i);
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void cumsumz_m(scicos_block *block,int flag)
{
double *ur = NULL;
double *ui = NULL;
double *yr = NULL;
double *yi = NULL;
int nu = 0,mu = 0,j = 0;
mu=GetInPortRows(block,1);
nu=GetInPortCols(block,1);
ur=GetRealInPortPtrs(block,1);
ui=GetImagInPortPtrs(block,1);
yr=GetRealOutPortPtrs(block,1);
yi=GetImagOutPortPtrs(block,1);
yr[0]=ur[0];
yi[0]=ui[0];
for(j=1;j<mu*nu;j++)
{
yr[j]=ur[j]+yr[j-1];
yi[j]=ui[j]+yi[j-1];
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matz_sqrt(scicos_block *block,int flag)
{
if (flag==1)
{
int i = 0;
int mu = GetInPortRows(block,1);
int nu = GetInPortCols(block,1);
double *ur = GetRealInPortPtrs(block,1);
double *ui = GetImagInPortPtrs(block,1);
double *yr = GetRealOutPortPtrs(block,1);
double *yi = GetImagOutPortPtrs(block,1);
for(i=0;i<mu*nu;i++)
{
double inpr = ur[i];
double inpi = ui[i];
C2F(wsqrt)(&inpr,&inpi,&yr[i],&yi[i]);
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matmul2_m(scicos_block *block,int flag)
{
if (flag==1){
int i = 0;
int ut=GetInType(block,1);
int mu=GetOutPortRows(block,1);
int nu=GetOutPortCols(block,1);
switch (ut)
{
case SCSREAL_N :{
double *u1=GetRealInPortPtrs(block,1);
double *u2=GetRealInPortPtrs(block,2);
double *y1=GetRealOutPortPtrs(block,1);
matmul2(y1,u1,u2,mu,nu);
break;}
case SCSINT32_N :{
long *u1=Getint32InPortPtrs(block,1);
long *u2=Getint32InPortPtrs(block,2);
long *y1=Getint32OutPortPtrs(block,1);
matmul2(y1,u1,u2,mu,nu);
break;}
case SCSINT16_N :{
short *u1=Getint16InPortPtrs(block,1);
short *u2=Getint16InPortPtrs(block,2);
short *y1=Getint16OutPortPtrs(block,1);
matmul2(y1,u1,u2,mu,nu);
break;}
case SCSINT8_N :{
char *u1=Getint8InPortPtrs(block,1);
char *u2=Getint8InPortPtrs(block,2);
char *y1=Getint8OutPortPtrs(block,1);
matmul2(y1,u1,u2,mu,nu);
break;}
case SCSUINT32_N :{
unsigned long *u1=Getuint32InPortPtrs(block,1);
unsigned long *u2=Getuint32InPortPtrs(block,2);
unsigned long *y1=Getuint32OutPortPtrs(block,1);
matmul2(y1,u1,u2,mu,nu);
break;}
case SCSUINT16_N :{
unsigned short *u1=Getuint16InPortPtrs(block,1);
unsigned short *u2=Getuint16InPortPtrs(block,2);
unsigned short *y1=Getuint16OutPortPtrs(block,1);
matmul2(y1,u1,u2,mu,nu);
break;}
case SCSUINT8_N :{
unsigned char *u1=Getuint8InPortPtrs(block,1);
unsigned char *u2=Getuint8InPortPtrs(block,2);
unsigned char *y1=Getuint8OutPortPtrs(block,1);
matmul2(y1,u1,u2,mu,nu);
break;}
case SCSCOMPLEX_N :{
double *u1r=GetRealInPortPtrs(block,1);
double *u2r=GetRealInPortPtrs(block,2);
double *y1r=GetRealOutPortPtrs(block,1);
double *u1i=GetImagInPortPtrs(block,1);
double *u2i=GetImagInPortPtrs(block,2);
double *y1i=GetImagOutPortPtrs(block,1);
for (i=0;i<mu*nu;i++)
{y1r[i]=(u1r[i]*u2r[i])-(u1i[i]*u2i[i]);
y1i[i]=(u1r[i]*u2i[i])+(u1i[i]*u2r[i]);}
break;}
default :{
set_block_error(-4);
return;}
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matz_inv(scicos_block *block,int flag)
{
double *ur = NULL;
double *yr = NULL;
double *ui = NULL;
double *yi = NULL;
int nu = 0;
int info = 0;
int i = 0;
mat_inv_struct *ptr = NULL;
nu =GetInPortRows(block,1);
ur=GetRealInPortPtrs(block,1);
ui=GetImagInPortPtrs(block,1);
yr=GetRealOutPortPtrs(block,1);
yi=GetImagOutPortPtrs(block,1);
/*init : initialization*/
if (flag==4)
{
if((*(block->work)=(mat_inv_struct*) scicos_malloc(sizeof(mat_inv_struct)))==NULL)
{
set_block_error(-16);
return;
}
ptr=*(block->work);
if((ptr->ipiv=(int*) scicos_malloc(sizeof(int)*nu))==NULL)
{
set_block_error(-16);
scicos_free(ptr);
return;
}
if((ptr->wrk=(double*) scicos_malloc(sizeof(double)*(2*nu*nu)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->LX=(double*) scicos_malloc(sizeof(double)*(2*nu*nu)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->LX);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
}
/* Terminaison */
else if (flag==5)
{
ptr=*(block->work);
if((ptr->LX)!=NULL)
{
scicos_free(ptr->ipiv);
scicos_free(ptr->LX);
scicos_free(ptr->wrk);
scicos_free(ptr);
return;
}
}
else
{
ptr=*(block->work);
for (i=0;i<(nu*nu);i++)
{
ptr->LX[2*i]=ur[i];
ptr->LX[2*i+1]=ui[i];
}
C2F(zgetrf)(&nu,&nu,ptr->LX,&nu,ptr->ipiv,&info);
if (info !=0)
{
if (flag!=6)
{set_block_error(-7);
return;
}
}
C2F(zgetri)(&nu,ptr->LX,&nu,ptr->ipiv,ptr->wrk,&nu,&info);
for (i=0;i<(nu*nu);i++)
{
yr[i]=ptr->LX[2*i];
yi[i]=ptr->LX[2*i+1];
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void mat_vpv(scicos_block *block,int flag)
{
double *u = NULL;
double *y1 = NULL;
double *y2 = NULL;
double *y3 = NULL;
double *y4 = NULL;
int nu = 0;
int info = 0;
int i = 0,j = 0,lwork = 0,lwork1 = 0,ii = 0,ij = 0,ij1 = 0,ji = 0;
int symmetric = 0;
mat_vps_struct *ptr = NULL;
nu =GetInPortRows(block,1);
u=GetRealInPortPtrs(block,1);
y1=GetRealOutPortPtrs(block,1);
y2=GetImagOutPortPtrs(block,1);
y3=GetRealOutPortPtrs(block,2);
y4=GetImagOutPortPtrs(block,2);
lwork1=4*nu;
lwork=3*nu-1;
/*init : initialization*/
if (flag==4)
{if((*(block->work)=(mat_vps_struct*) scicos_malloc(sizeof(mat_vps_struct)))==NULL)
{set_block_error(-16);
return;}
ptr=*(block->work);
if((ptr->LA=(double*) scicos_malloc(sizeof(double)*(nu*nu)))==NULL)
{set_block_error(-16);
scicos_free(ptr);
return;}
if((ptr->L0=(double*) scicos_malloc(sizeof(double)))==NULL)
{set_block_error(-16);
scicos_free(ptr->LA);
scicos_free(ptr);
return;}
if((ptr->LVR=(double*) scicos_malloc(sizeof(double)*(nu*nu)))==NULL)
{set_block_error(-16);
scicos_free(ptr->L0);
scicos_free(ptr->LA);
scicos_free(ptr);
return;}
if((ptr->LW=(double*) scicos_malloc(sizeof(double)*(nu*nu)))==NULL)
{set_block_error(-16);
scicos_free(ptr->LVR);
scicos_free(ptr->L0);
scicos_free(ptr->LA);
scicos_free(ptr);
return;}
if((ptr->LWR=(double*) scicos_malloc(sizeof(double)*(nu*1)))==NULL)
{set_block_error(-16);
scicos_free(ptr->LW);
scicos_free(ptr->LVR);
scicos_free(ptr->L0);
scicos_free(ptr->LA);
scicos_free(ptr);
return;}
if((ptr->LWI=(double*) scicos_malloc(sizeof(double)*(nu*1)))==NULL)
{set_block_error(-16);
scicos_free(ptr->LWR);
scicos_free(ptr->LW);
scicos_free(ptr->LVR);
scicos_free(ptr->L0);
scicos_free(ptr->LA);
scicos_free(ptr);
return;}
if((ptr->dwork=(double*) scicos_malloc(sizeof(double)*lwork))==NULL)
{set_block_error(-16);
scicos_free(ptr->LWI);
scicos_free(ptr->LWR);
scicos_free(ptr->LW);
scicos_free(ptr->LVR);
scicos_free(ptr->L0);
scicos_free(ptr->LA);
scicos_free(ptr);
return;}
if((ptr->dwork1=(double*) scicos_malloc(sizeof(double)*lwork1))==NULL)
{set_block_error(-16);
scicos_free(ptr->dwork);
scicos_free(ptr->LWI);
scicos_free(ptr->LWR);
scicos_free(ptr->LW);
scicos_free(ptr->LVR);
scicos_free(ptr->L0);
scicos_free(ptr->LA);
scicos_free(ptr);
return;}
}
/* Terminaison */
else if (flag==5)
{ptr=*(block->work);
if(ptr->dwork1!=NULL){
scicos_free(ptr->LA);
scicos_free(ptr->L0);
scicos_free(ptr->LVR);
scicos_free(ptr->LW);
scicos_free(ptr->LWI);
scicos_free(ptr->LWR);
scicos_free(ptr->dwork);
scicos_free(ptr->dwork1);
scicos_free(ptr);
return;}
}
else
{
ptr=*(block->work);
C2F(dlacpy)("F",&nu,&nu,u,&nu,ptr->LA,&nu);
symmetric=1;
for (j=0;j<nu;j++)
{for (i=j;i<nu;i++)
{ij=i+j*nu;
ji=j+i*nu;
if (i!=j)
{if (*(ptr->LA+ij)==*(ptr->LA+ji)) symmetric*= 1;
else { symmetric*=0;break;}}}}
if (symmetric==1)
{C2F(dsyev)("V","U",&nu,ptr->LA,&nu,ptr->LW,ptr->dwork,&lwork,&info);
if (info!=0)
{if (flag!=6)
{set_block_error(-7);
return;
}}
for (i=0;i<nu;i++)
{ii=i+i*nu;
*(y1+ii)=*(ptr->LW+i);
}
C2F(dlacpy)("F",&nu,&nu,ptr->LA,&nu,y3,&nu);
}
else
{C2F(dgeev)("N","V",&nu,ptr->LA,&nu,ptr->LWR,ptr->LWI,ptr->dwork1,&nu,ptr->LVR,&nu,ptr->dwork1,&lwork1,&info);
if (info!=0)
{if (flag!=6)
{set_block_error(-7);
return;
}}
*(ptr->L0)=0;
C2F(dlaset)("F",&nu,&nu,ptr->L0,ptr->L0,y1,&nu);
C2F(dlaset)("F",&nu,&nu,ptr->L0,ptr->L0,y2,&nu);
for (i=0;i<nu;i++)
{ii=i+i*nu;
*(y1+ii)=*(ptr->LWR+i);
*(y2+ii)=*(ptr->LWI+i);
}
for (j=0;j<nu;j++)
{if (*(ptr->LWI+j)==0)
for (i=0;i<nu;i++)
{ij=i+(j)*nu;
*(y3+ij)=*(ptr->LVR +ij);
*(y4+ij)=0;}
else{
for (i=0;i<nu;i++)
{ij=i+(j)*nu;
ij1=i+(j+1)*nu;
*(y3+ij)=*(ptr->LVR +ij);
*(y4+ij)=*(ptr->LVR +ij1);
*(y3+ij1)=*(ptr->LVR +ij);
*(y4+ij1)=-(*(ptr->LVR +ij1));}
j++;}
}
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void integralz_func(scicos_block *block, int flag)
{
int i = 0;
double *ur = NULL, *ui = NULL;
double *yr = NULL, *yi = NULL;
ur = GetRealInPortPtrs(block, 1);
ui = GetImagInPortPtrs(block, 1);
yr = GetRealOutPortPtrs(block, 1);
yi = GetImagOutPortPtrs(block, 1);
if (flag == 0)
{
if (block->ng > 0)
{
for (i = 0; i < (block->nx) / 2; ++i)
{
if (block->mode[i] == 3)
{
block->xd[i] = ur[i];
block->xd[i + (block->nx) / 2] = ui[i];
}
else
{
block->xd[i] = 0.0;
block->xd[i + (block->nx) / 2] = 0.0;
}
}
}
else
{
for (i = 0; i < (block->nx) / 2; ++i)
{
block->xd[i] = ur[i];
block->xd[i + (block->nx) / 2] = ui[i];
}
}
}
else if (flag == 1 || flag == 6)
{
for (i = 0; i < (block->nx) / 2; ++i)
{
yr[i] = block->x[i];
yi[i] = block->x[i + (block->nx) / 2];
}
}
else if (flag == 2 && block->nevprt == 1)
{
for (i = 0; i < (block->nx) / 2; ++i)
{
block->x[i] = ur[i];
block->x[i + (block->nx) / 2] = ui[i];
}
}
else if (flag == 9)
{
for (i = 0; i < (block->nx) / 2; ++i)
{
if (block->mode[i] == 3)
{
block->g[i] = (block->x[i] - (block->rpar[i])) * (block->x[i] - (block->rpar[(block->nx) / 2 + i]));
block->g[i + (block->nx) / 2] = (block->x[i + (block->nx) / 2] - (block->rpar[i + (block->nx)])) * (block->x[i + (block->nx) / 2] - (block->rpar[3 * (block->nx) / 2 + i]));
}
else
{
block->g[i] = ur[i];
block->g[i + (block->nx) / 2] = ui[i];
}
if (get_phase_simulation() == 1)
{
if ((ur[i] >= 0) && (block->x[i] >= block->rpar[i])
&& (fpclassify(ui[i >= 0]) != FP_ZERO)
&& (block->x[i + (block->nx) / 2] >= block->rpar[i + (block->nx)]))
{
block->mode[i] = 1;
}
else if (ur[i] <= 0 && block->x[i] <= block->rpar[(block->nx) / 2 + i] && ui[i] <= 0 && block->x[i + (block->nx) / 2] <= block->rpar[3 * (block->nx) / 2 + i])
{
block->mode[i] = 2;
}
else
{
block->mode[i] = 3;
}
}
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matz_bksl(scicos_block *block,int flag)
{
double *u1r = NULL,*u1i = NULL;
double *u2r = NULL,*u2i = NULL;
double *yr = NULL,*yi = NULL;
int mu = 0,vu = 0,wu = 0;
int nu1 = 0;
int nu2 = 0;
int info = 0;
int i = 0,j = 0,l = 0,lw = 0,lu = 0,rw = 0,ij = 0,k = 0;
mat_bksl_struct *ptr = NULL;
double rcond = 0., ANORM = 0., EPS = 0.;
vu =GetOutPortRows(block,1);
wu =GetOutPortCols(block,1);
mu =GetInPortRows(block,1);
nu1 =GetInPortCols(block,1);
nu2 =GetInPortCols(block,2);
u1r=GetRealInPortPtrs(block,1);
u1i=GetImagInPortPtrs(block,1);
u2r=GetRealInPortPtrs(block,2);
u2i=GetImagInPortPtrs(block,2);
yr=GetRealOutPortPtrs(block,1);
yi=GetImagOutPortPtrs(block,1);
l=Max(mu,nu1);
lw=Max(2*Min(mu,nu1),nu1+1);
lu=Max(lw,Min(mu,nu1)+nu2);
lw=Max(2*nu1,Min(mu,nu1)+lu);
rw=2*nu1;
/*init : initialization*/
if (flag==4)
{
if((*(block->work)=(mat_bksl_struct*) scicos_malloc(sizeof(mat_bksl_struct)))==NULL)
{
set_block_error(-16);
return;
}
ptr=*(block->work);
if((ptr->ipiv=(int*) scicos_malloc(sizeof(int)*nu1))==NULL)
{
set_block_error(-16);
scicos_free(ptr);
return;
}
if((ptr->rank=(int*) scicos_malloc(sizeof(int)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->jpvt=(int*) scicos_malloc(sizeof(int)*nu1))==NULL)
{
set_block_error(-16);
scicos_free(ptr->rank);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->iwork=(double*) scicos_malloc(sizeof(double)*2*nu1))==NULL)
{set_block_error(-16);
scicos_free(ptr->jpvt);
scicos_free(ptr->rank);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->dwork=(double*) scicos_malloc(sizeof(double)*2*lw))==NULL)
{
set_block_error(-16);
scicos_free(ptr->iwork);
scicos_free(ptr->jpvt);
scicos_free(ptr->rank);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->IN1F=(double*) scicos_malloc(sizeof(double)*(2*mu*nu1)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->dwork);
scicos_free(ptr->iwork);
scicos_free(ptr->jpvt);
scicos_free(ptr->rank);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->IN1=(double*) scicos_malloc(sizeof(double)*(2*mu*nu1)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->IN1F);
scicos_free(ptr->dwork);
scicos_free(ptr->iwork);
scicos_free(ptr->jpvt);
scicos_free(ptr->rank);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->IN2X=(double*) scicos_malloc(sizeof(double)*(2*l*nu2)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->IN1);
scicos_free(ptr->IN1F);
scicos_free(ptr->dwork);
scicos_free(ptr->iwork);
scicos_free(ptr->jpvt);
scicos_free(ptr->rank);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if((ptr->IN2=(double*) scicos_malloc(sizeof(double)*(2*mu*nu2)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->IN2);
scicos_free(ptr->IN1);
scicos_free(ptr->IN1F);
scicos_free(ptr->dwork);
scicos_free(ptr->iwork);
scicos_free(ptr->jpvt);
scicos_free(ptr->rank);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
}
/* Terminaison */
else if (flag==5)
{
ptr=*(block->work);
if((ptr->IN2)!=NULL)
{
scicos_free(ptr->ipiv);
scicos_free(ptr->rank);
scicos_free(ptr->jpvt);
scicos_free(ptr->iwork);
scicos_free(ptr->IN1F);
scicos_free(ptr->IN1);
scicos_free(ptr->IN2X);
scicos_free(ptr->IN2);
scicos_free(ptr->dwork);
scicos_free(ptr);
return;
}
}
else
{
ptr=*(block->work);
for (i=0;i<(mu*nu1);i++)
{
ptr->IN1[2*i]=u1r[i];
ptr->IN1[2*i+1]=u1i[i];
}
for (i=0;i<(mu*nu2);i++)
{
ptr->IN2[2*i]=u2r[i];
ptr->IN2[2*i+1]=u2i[i];
}
EPS=C2F(dlamch)("e",1L);
ANORM=C2F(zlange)("1",&mu,&nu1,ptr->IN1,&mu,ptr->dwork);
if (mu==nu1)
{
C2F(zlacpy)("F",&mu,&nu1,ptr->IN1,&mu,ptr->IN1F,&mu);
C2F(zgetrf)(&nu1,&nu1,ptr->IN1F,&nu1,ptr->ipiv,&info);
rcond=0;
if (info==0)
{
C2F(zgecon)("1",&nu1,ptr->IN1F,&nu1,&ANORM,&rcond,ptr->dwork,ptr->iwork,&info);
if (rcond>pow(EPS,0.5))
{
C2F(zgetrs)("N",&nu1,&nu2,ptr->IN1F,&nu1,ptr->ipiv,ptr->IN2,&nu1,&info);
for (i=0;i<(mu*nu2);i++)
{*(yr+i)=*(ptr->IN2+2*i);
*(yi+i)=*(ptr->IN2+(2*i)+1);}
return;
}
}
}
rcond=pow(EPS,0.5);
for (i=0;i<nu1;i++) *(ptr->jpvt+i)=0;
C2F(zlacpy)("F",&mu,&nu2,ptr->IN2,&mu,ptr->IN2X,&l);
C2F(zgelsy1)(&mu,&nu1,&nu2,ptr->IN1,&mu,ptr->IN2X,&l,ptr->jpvt,&rcond,ptr->rank,ptr->dwork,&lw,ptr->iwork,&info);
if (info!=0)
{
if (flag!=6)
{
set_block_error(-7);
return;
}
}
k=0;
for(j=0;j<wu;j++)
{
for(i=0;i<vu;i++)
{
ij=i+j*l;
*(yr+k)=*(ptr->IN2X+2*ij);
*(yi+k)=*(ptr->IN2X+(2*ij)+1);
k++;
}
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matz_lu(scicos_block *block, int flag)
{
double *ur = NULL;
double *ui = NULL;
double *y1r = NULL;
double *y1i = NULL;
double *y2r = NULL;
double *y2i = NULL;
int mu = 0;
int nu = 0;
int info = 0;
int i = 0, j = 0, l = 0, ij = 0, ik = 0, ij1 = 0;
mat_lu_struct *ptr = NULL;
mu = GetInPortRows(block, 1);
nu = GetInPortCols(block, 1);
ur = GetRealInPortPtrs(block, 1);
ui = GetImagInPortPtrs(block, 1);
y1r = GetRealOutPortPtrs(block, 1);
y1i = GetImagOutPortPtrs(block, 1);
y2r = GetRealOutPortPtrs(block, 2);
y2i = GetImagOutPortPtrs(block, 2);
l = Min(mu, nu);
/*init : initialization*/
if (flag == 4)
{
if ((*(block->work) = (mat_lu_struct*) scicos_malloc(sizeof(mat_lu_struct))) == NULL)
{
set_block_error(-16);
return;
}
ptr = *(block->work);
if ((ptr->ipiv = (int*) scicos_malloc(sizeof(int) * nu)) == NULL)
{
set_block_error(-16);
scicos_free(ptr);
return;
}
if ((ptr->dwork = (double*) scicos_malloc(sizeof(double) * (2 * mu * nu))) == NULL)
{
set_block_error(-16);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if ((ptr->IL = (double*) scicos_malloc(sizeof(double) * (mu * l))) == NULL)
{
set_block_error(-16);
scicos_free(ptr->dwork);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
if ((ptr->IU = (double*) scicos_malloc(sizeof(double) * (l * nu))) == NULL)
{
set_block_error(-16);
scicos_free(ptr->IL);
scicos_free(ptr->dwork);
scicos_free(ptr->ipiv);
scicos_free(ptr);
return;
}
}
/* Terminaison */
else if (flag == 5)
{
ptr = *(block->work);
if ((ptr->IU) != NULL)
{
scicos_free(ptr->ipiv);
scicos_free(ptr->dwork);
scicos_free(ptr->IL);
scicos_free(ptr->IU);
scicos_free(ptr);
return;
}
}
else
{
ptr = *(block->work);
for (i = 0; i < (mu * nu); i++)
{
ptr->dwork[2 * i] = ur[i];
ptr->dwork[2 * i + 1] = ui[i];
}
C2F(zgetrf)(&mu, &nu, ptr->dwork, &mu, ptr->ipiv, &info);
if (info != 0)
{
if (flag != 6)
{
set_block_error(-7);
return;
}
}
for (j = 0; j < l; j++)
{
for (i = 0; i < mu; i++)
{
ij = i + j * mu;
ij1 = 2 * ij;
if (i == j)
{
*(y2r + ij) = 1;
*(y2i + ij) = 0;
}
else if (i > j)
{
*(y2r + ij) = *(ptr->dwork + ij1);
*(y2i + ij) = *(ptr->dwork + ij1 + 1);
}
else
{
*(y2r + ij) = 0;
*(y2i + ij) = 0;
}
}
}
for (j = 0; j < nu; j++)
{
for (i = 0; i < l; i++)
{
ij = i + j * l;
ik = 2 * (i + j * mu);
if (i <= j)
{
*(y1r + ij) = *(ptr->dwork + ik);
*(y1i + ij) = *(ptr->dwork + ik + 1);
}
else
{
*(y1r + ij) = 0;
*(y1i + ij) = 0;
}
}
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void rndblkz_m(scicos_block *block, int flag)
{
double *y_r = NULL;
double *y_i = NULL;
double *rpar = NULL;
double *z = NULL;
int *ipar = NULL;
int ny = 0, my = 0, i = 0, iy_r = 0, iy_i = 0;
double sr = 0., si = 0., tl = 0.;
my = GetOutPortRows(block, 1);
ny = GetOutPortCols(block, 1);
ipar = GetIparPtrs(block);
rpar = GetRparPtrs(block);
y_r = GetRealOutPortPtrs(block, 1);
y_i = GetImagOutPortPtrs(block, 1);
z = GetDstate(block);
if (flag == 2 || flag == 4)
{
iy_r = (int)z[0];
iy_i = (int)z[1];
if (ipar[0] == 0)
{
for (i = 0; i < my * ny; i++)
{
*(z + i + 2) = C2F(urand)(&iy_r);
*(z + i + 2 + my * ny) = C2F(urand)(&iy_i);
}
}
else
{
for (i = 0; i < my * ny; i++)
{
do
{
sr = 2.0 * C2F(urand)(&iy_r) - 1.0;
si = 2.0 * C2F(urand)(&iy_r) - 1.0;
tl = sr * sr + si * si;
}
while (tl > 1.0);
z[i + 2] = sr * (sqrt(-2.0 * log(tl) / tl));
do
{
sr = 2.0 * C2F(urand)(&iy_i) - 1.0;
si = 2.0 * C2F(urand)(&iy_i) - 1.0;
tl = sr * sr + si * si;
}
while (tl > 1.0);
z[i + 2 + my * ny] = sr * (sqrt(-2.0 * log(tl) / tl));
}
}
*(z) = iy_r;
*(z + 1) = iy_i;
}
if (flag == 1 || flag == 6)
{
for (i = 0; i < my * ny; i++)
{
*(y_r + i) = *(rpar + i) + (*(rpar + i + 2 * my * ny)) * (*(z + i + 2));
*(y_i + i) = *(rpar + i + my * ny) + (*(rpar + i + 3 * my * ny)) * (*(z + i + 2 + my * ny));
}
}
}
/*--------------------------------------------------------------------------*/
SCICOS_BLOCKS_IMPEXP void matz_vpv(scicos_block *block,int flag)
{
double *ur = NULL,*ui = NULL;
double *y1r = NULL,*y1i = NULL,*y2r = NULL,*y2i = NULL;
int nu = 0;
int info = 0;
int i = 0,lwork = 0,lwork1 = 0,j = 0,ii = 0,ij = 0,ji = 0,rw = 0;
int hermitien = 0;
double l0 = 0.;
mat_vpv_struct *ptr = NULL;
nu =GetInPortRows(block,1);
ur=GetRealInPortPtrs(block,1);
ui=GetImagInPortPtrs(block,1);
y1r=GetRealOutPortPtrs(block,1);
y1i=GetImagOutPortPtrs(block,1);
y2r=GetRealOutPortPtrs(block,2);
y2i=GetImagOutPortPtrs(block,2);
lwork1=2*nu;
lwork=2*nu-1;
rw=3*nu-2;
/*init : initialization*/
if (flag==4)
{
if((*(block->work)=(mat_vpv_struct*) scicos_malloc(sizeof(mat_vpv_struct)))==NULL)
{
set_block_error(-16);
return;
}
ptr=*(block->work);
if((ptr->LA=(double*) scicos_malloc(sizeof(double)*(2*nu*nu)))==NULL)
{
set_block_error(-16);
scicos_free(ptr);
return;
}
if((ptr->LX=(double*) scicos_malloc(sizeof(double)*(2*nu)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->LA);
scicos_free(ptr);
return;
}
if((ptr->LVR=(double*) scicos_malloc(sizeof(double)*(2*nu*nu)))==NULL)
{
set_block_error(-16);
scicos_free(ptr->LX);
scicos_free(ptr->LA);
scicos_free(ptr);
return;
}
if((ptr->dwork=(double*) scicos_malloc(sizeof(double)*2*lwork))==NULL)
{
set_block_error(-16);
scicos_free(ptr->LVR);
scicos_free(ptr->LX);
scicos_free(ptr->LA);
scicos_free(ptr);
return;
}
if((ptr->rwork=(double*) scicos_malloc(sizeof(double)*2*rw))==NULL)
{
set_block_error(-16);
scicos_free(ptr->dwork);
scicos_free(ptr->LVR);
scicos_free(ptr->LX);
scicos_free(ptr->LA);
scicos_free(ptr);
return;
}
if((ptr->dwork1=(double*) scicos_malloc(sizeof(double)*2*lwork1))==NULL)
{
set_block_error(-16);
scicos_free(ptr->rwork);
scicos_free(ptr->dwork);
scicos_free(ptr->LVR);
scicos_free(ptr->LX);
scicos_free(ptr->LA);
scicos_free(ptr);
return;
}
if((ptr->rwork1=(double*) scicos_malloc(sizeof(double)*2*lwork1))==NULL)
{
set_block_error(-16);
scicos_free(ptr->dwork1);
scicos_free(ptr->rwork);
scicos_free(ptr->dwork);
scicos_free(ptr->LVR);
scicos_free(ptr->LX);
scicos_free(ptr->LA);
scicos_free(ptr);
return;
}
}
/* Terminaison */
else if (flag==5)
{
ptr=*(block->work);
if((ptr->rwork1)!=NULL)
{
scicos_free(ptr->LA);
scicos_free(ptr->LX);
scicos_free(ptr->LVR);
scicos_free(ptr->rwork);
scicos_free(ptr->rwork1);
scicos_free(ptr->dwork);
scicos_free(ptr->dwork1);
scicos_free(ptr);
return;
}
}
else
{
ptr=*(block->work);
for (i=0;i<(nu*nu);i++)
{
ptr->LA[2*i]=ur[i];
ptr->LA[2*i+1]=ui[i];
}
hermitien=1;
for (j=0;j<nu;j++)
{
for (i=j;i<nu;i++)
{
ij=i+j*nu;
ji=j+i*nu;
if (i!=j)
{
if ((*(ptr->LA+2*ij)==*(ptr->LA+2*ji))&&(*(ptr->LA+2*ij+1)==-(*(ptr->LA+2*ji+1)))) hermitien*= 1;
else { hermitien*=0;break;
}
}
}
}
if (hermitien==1)
{
C2F(zheev)("V","U",&nu,ptr->LA,&nu,ptr->LX,ptr->dwork,&lwork,ptr->rwork,&info);
if (info!=0)
{
if (flag!=6)
{
set_block_error(-7);
return;
}
}
for (i=0;i<nu;i++)
{
ii=i+i*nu;
*(y1r+ii)=*(ptr->LX+i);
}
for(i=0;i<nu*nu;i++)
{
*(y2r+i)=*(ptr->LA+2*i);
*(y2i+i)=*(ptr->LA+2*i+1);
}
}
else
{
C2F(zgeev)("N","V",&nu,ptr->LA,&nu,ptr->LX,ptr->dwork1,&nu,ptr->LVR,&nu,ptr->dwork1,&lwork1,ptr->rwork1,&info);
if (info!=0)
{
if (flag!=6)
{
set_block_error(-7);
return;
}
}
l0=0;
C2F(dlaset)("F",&nu,&nu,&l0,&l0,y1r,&nu);
C2F(dlaset)("F",&nu,&nu,&l0,&l0,y1i,&nu);
C2F(dlaset)("F",&nu,&nu,&l0,&l0,y2r,&nu);
C2F(dlaset)("F",&nu,&nu,&l0,&l0,y2i,&nu);
for (i=0;i<nu;i++)
{
ii=i+i*nu;
*(y1r+ii)=*(ptr->LX+2*i);
*(y1i+ii)=*(ptr->LX+2*i+1);
}
for(i=0;i<nu*nu;i++)
{
*(y2r+i)=*(ptr->LVR+2*i);
*(y2i+i)=*(ptr->LVR+2*i+1);
}
}
}
}