character :: type
int BLAS_iussv (blas_trans_type transt=ORIGIN_MATRIX, int alpha, blas_sparse_matrix T, int *x, int incx)
{
int ierr = -1;
int transa_work,alpha_work;
transa_work=transt;
alpha_work=alpha;
char type;
ISPMAT * dspmtx;//date of spmatrix
int* z;
ierr=accessdata_isp(T,dspmtx);
if(ierr!=0)
return ierr=blas_error_param;
get_descra(dspmtx->DESCRA,'t',type,ierr);
if(ierr!=0)
return ierr=blas_error_param;
if (type!='T')
return ierr = blas_error_param;
malloc(incx*sizeof(int);
allocate(z(size(x)),STAT=ierr)
if (ierr.ne.0) then
ierr = blas_error_memalloc
return
end if
z= (x)
select case(transa_work)
case(ORIGIN_MATRIX)
select case(dspmtx%FIDA)
case('COO')
call rsbv_coo(dspmtx,x,ierr)
case('CSC')
call rsbv_csc(dspmtx,x,ierr)
case('CSR')
call rsbv_csr(dspmtx,x,ierr)
case('DIA')
call rsbv_dia(dspmtx,x,ierr)
case('BCO')
call rsbv_bco(dspmtx,x,ierr)
case('BSC')
call rsbv_bsc(dspmtx,x,ierr)
case('BSR')
call rsbv_bsr(dspmtx,x,ierr)
case('BDI')
call rsbv_bdi(dspmtx,x,ierr)
case('VBR')
call rsbv_vbr(dspmtx,x,ierr)
case default
ierr = blas_error_param
end select
case(TRANSP_MATRIX)
select case(dspmtx%FIDA)
case('COO')
call lsbv_coo(dspmtx,z,ierr)
case('CSC')
call lsbv_csc(dspmtx,z,ierr)
case('CSR')
call lsbv_csr(dspmtx,z,ierr)
case('DIA')
call lsbv_dia(dspmtx,z,ierr)
case('BCO')
call lsbv_bco(dspmtx,z,ierr)
case('BSC')
call lsbv_bsc(dspmtx,z,ierr)
case('BSR')
call lsbv_bsr(dspmtx,z,ierr)
case('BDI')
call lsbv_bdi(dspmtx,z,ierr)
case('VBR')
call lsbv_vbr(dspmtx,z,ierr)
case default
ierr = blas_error_param
end select
case default
ierr = blas_error_param
end select
if (ierr.ne.0) then
return
end if
end if
if(transa_work.eq.ORIGIN_MATRIX) then
x = alpha_work * x
else
x = alpha_work * ( (z))
end if
ierr = 0
end subroutine iussv
// **********************************************************************
// Author : luoyulong
// Date of last modification : 7.7.00
// Description : PERFORMS MV MULT. WITH MATRIX IN 'BDI'-STORAGE
// rmbv = Right Multiplication By Vector: y=Ax
// **********************************************************************
void drmbv_bdi (DSPMAT* mat,double* x,int n,double* y,int m,int* ierr)
{
int i,j,mm,nn,nn_sq,mb,nb;
int blda,nbdiag,start_a,end_a,start_x,start_y;
int aa,xx,yy;
char diag,type,part,store;
*ierr = -1;
get_infoa(mat->INFOA,'d',&mm,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'e',&nn,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'f',&blda,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'g',&nbdiag,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'d',&diag,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'f',&store,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'t',&type,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'a',&part,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
mb = (mat->M+mm-1)/mm;
nb = (mat->K+nn-1)/nn;
if ((mat->FIDA!=BDI_FORMAT)||(mat->M!=m)||(mat->K!=n)||(mm!=nn)) {
*ierr = blas_error_param;
return;
}
memset (y,0,sizeof(double)*m);
nn_sq = nn*nn;
if (diag=='U') { //process unstored diagonal
if (m==n)
memcpy (y,x,sizeof(double)*m);
else{
*ierr = blas_error_param;
return;
}
}
if ((type=='S')&&(!(part=='B'))&&(m==n)) {
if (part=='U') {
for(i=0;i<nbdiag;i++)
{// in this situation,start_x=0
start_x =(mat->IA1[i])>0?(mat->IA1[i]):0;
start_y = (-mat->IA1[i])>0?(-mat->IA1[i]):0;
if (mat->IA1[i]>0)
{
start_a=i*blda;
//here end_a equal the length of diagonal
end_a=(blda-mat->IA1[i])+((mat->K/nn)-blda);
for(j=0;j<end_a;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(start_a+j)*nn_sq;
xx=(start_y+j)*nn;
yy=(start_x+j)*nn;
dblock_T_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else if (mat->IA1[i]==0)
{
start_a=i*blda;
end_a=blda;
for(j=0;j<end_a;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else
{
continue;
}
}
}
else
{
for(i=0;i<nbdiag;i++)
{// in this situation,start_y=0
start_x =(mat->IA1[i])>0?(mat->IA1[i]):0;
start_y = (-mat->IA1[i])>0?(-mat->IA1[i]):0;
if (mat->IA1[i]<0) {
end_a=(blda+mat->IA1[i])+((mat->M/nn)-blda);
start_a=(i+1)*blda-end_a;
for(j=0;j<end_a;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(start_a+j)*nn_sq;
xx=(start_y+j)*nn;
yy=(start_x+j)*nn;
dblock_T_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else if (mat->IA1[i]==0)
{
start_a=i*blda;
end_a=blda;
for(j=0;j<blda;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else
{
continue;
}
}
}
*ierr = 0;
}
else if ((type=='H')&&(!(part=='B'))&&(m==n))
{
if (part=='U') {
for(i=0;i<nbdiag;i++)
{// in this situation,start_x=0
start_x =(mat->IA1[i])>0?(mat->IA1[i]):0;
start_y = (-mat->IA1[i])>0?(-mat->IA1[i]):0;
if (mat->IA1[i]>0)
{
start_a=i*blda;
//here end_a equal the length of diagonal
end_a=(blda-mat->IA1[i])+((mat->K/nn)-blda);
for(j=0;j<end_a;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(start_a+j)*nn_sq;
xx=(start_y+j)*nn;
yy=(start_x+j)*nn;
dblock_H_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else if (mat->IA1[i]==0)
{
start_a=i*blda;
end_a=blda;
for(j=0;j<blda;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else
{
continue;
}
}
}
else//lower
{
for(i=0;i<nbdiag;i++)
{// in this situation,start_y=0
start_x =(mat->IA1[i])>0?(mat->IA1[i]):0;
start_y = (-mat->IA1[i])>0?(-mat->IA1[i]):0;
if (mat->IA1[i]<0) {
end_a=(blda+mat->IA1[i])+((mat->M/nn)-blda);
start_a=(i+1)*blda-end_a;
for(j=0;j<end_a;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(start_a+j)*nn_sq;
xx=(start_y+j)*nn;
yy=(start_x+j)*nn;
dblock_H_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else if (mat->IA1[i]==0)
{
start_a=i*blda;
end_a=blda;
for(j=0;j<blda;j++)
{
aa=(start_a+j)*nn_sq;
xx=(start_x+j)*nn;
yy=(start_y+j)*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
}
else
{
continue;
}
}
}
*ierr = 0;
}
else
{ //no symmetry
rmbv_bdi(mat->IA1,mat->A,mat->M,mat->K,nbdiag,blda,mb,nb,mm,nn,x,y);
*ierr = 0;
}
}// drmbv_bdi
// **********************************************************************
// Author : luoyulong
// Date of last modification : 7.7.00
// Description : PERFORMS MV MULT. WITH MATRIX IN 'DIA'-STORAGE
// lmbv = Left Multiplication By Vector: y^T=x^TA
// **********************************************************************
void dlmbv_dia( DSPMAT* mat,double* x,int n, double* y,int m,int* ierr)
{
int i,j;
int lda,ndiag,start_a,end_a,start_x,start_y;
char diag,type,part;
*ierr = -1;
if ((mat->FIDA!=DIA_FORMAT)||(mat->M!=n)||(mat->K!=m)) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'d',&lda,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'e',&ndiag,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'d',&diag,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'t',&type,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'a',&part,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
memset (y,0,sizeof(double)*m);
if (diag=='U')
{ //process unstored diagonal
if (m==n)
memcpy (y,x,sizeof(double)*m);
else
{
*ierr = blas_error_param;
return;
}
}
if ((type=='S')&&(!(part=='B'))&&(m==n)) {
if (part=='U') {
for(i=0;i<ndiag;i++)
{// in this situation,start_x=0
start_x =(-mat->IA1[i])>0?(-mat->IA1[i]):0;
start_y = (mat->IA1[i])>0?(mat->IA1[i]):0;
if (mat->IA1[i]>0)
{
start_a=i*lda;
//here end_a equal the length of diagonal
end_a=(lda-mat->IA1[i])+(mat->K-lda);
for(j=0;j<end_a;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
y[start_x+j]+=mat->A[start_a+j]*x[start_y+j];
}
}
else if (mat->IA1[i]==0)
{
start_a=i*lda;
end_a=lda;
for(j=0;j<lda;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
}
}
else
{
continue;
}
}
}
else
{
for(i=0;i<ndiag;i++)
{// in this situation,start_y=0
start_x =(-mat->IA1[i])>0?(-mat->IA1[i]):0;
start_y = (mat->IA1[i])>0?(mat->IA1[i]):0;
if (mat->IA1[i]<0) {
end_a=(lda+mat->IA1[i])+(mat->M-lda);
start_a=(i+1)*lda-end_a;
for(j=0;j<end_a;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
y[start_x+j]+=mat->A[start_a+j]*x[start_y+j];
}
}
else if (mat->IA1[i]==0)
{
start_a=i*lda;
end_a=lda;
for(j=0;j<lda;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
}
}
else
{
continue;
}
}
}
*ierr = 0;
}
else if ((type=='H')&&(!(part=='B'))&&(m==n))
{
if (part=='U') {
for(i=0;i<ndiag;i++)
{// in this situation,start_x=0
start_x =(-mat->IA1[i])>0?(-mat->IA1[i]):0;
start_y = (mat->IA1[i])>0?(mat->IA1[i]):0;
if (mat->IA1[i]>0)
{
start_a=i*lda;
//here end_a equal the length of diagonal
end_a=(lda-mat->IA1[i])+(mat->K-lda);
for(j=0;j<end_a;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
y[start_x+j]+=mat->A[start_a+j]*x[start_y+j];
}
}
else if (mat->IA1[i]==0)
{
start_a=i*lda;
end_a=lda;
for(j=0;j<lda;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
}
}
else
{
continue;
}
}
}
else
{
for(i=0;i<ndiag;i++)
{// in this situation,start_y=0
start_x =(-mat->IA1[i])>0?(-mat->IA1[i]):0;
start_y = (mat->IA1[i])>0?(mat->IA1[i]):0;
if (mat->IA1[i]<0) {
end_a=(lda+mat->IA1[i])+(mat->M-lda);
start_a=(i+1)*lda-end_a;
for(j=0;j<end_a;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
y[start_x+j]+=mat->A[start_a+j]*x[start_y+j];
}
}
else if (mat->IA1[i]==0)
{
start_a=i*lda;
end_a=lda;
for(j=0;j<lda;j++)
{
y[start_y+j]+=mat->A[start_a+j]*x[start_x+j];
}
}
else
{
continue;
}
}
}
*ierr = 0;
}
else
{ //no symmetry
lmbv_dia(mat->IA1,mat->A,mat->M,mat->K,ndiag,lda,x,y);
*ierr = 0;
}
}// dlmbv_dia
dsp_linknode* duscr_csc (int m,int n,double* val,int n_val,int* indx,int n_indx,int* pntrb,int n_pntrb,int* pntre,int n_pntre,int prpty,int* istat)
{
int options,base,nnz;
bool COPY;
char message;
DSPMAT* dsp_data;
dsp_linknode* dsp_l;
int i;
options=*istat;
*istat=-1; //if not changed later,routine has failed
dsp_l=new_dsp(istat);
if(*istat!=0) {//then
*istat=blas_error_memalloc;
return NULL;
}//end if
dsp_data=accessdata_dsp(dsp_l,istat);
if(*istat!=0) {//then
*istat=blas_error_param;
return NULL;
}//end if
dsp_data->FIDA=CSC_FORMAT;
dsp_data->M=m;
dsp_data->K=n;
set_descra(dsp_data->DESCRA,prpty,istat);
get_descra(dsp_data->DESCRA,'b',&message,istat);
if (message=='C')
base=C_BASE;
else //Assuming F base
base=F_BASE;
set_infoa(dsp_data->INFOA,'b',base,istat);
nnz=maxval(pntre,n_pntre)-base;
set_infoa(dsp_data->INFOA,'n',nnz,istat);
if((nnz!=n_indx)||(n!=n_pntrb)||(minval(indx,n_indx)<base)||(maxval(indx,n_indx)>m-1+base)||(n!=n_pntre)||(nnz!=n_val)) {//then
BLAS_usds(dsp_l,3);
*istat=blas_error_param;
return NULL;
}
//init the size of array in dsp
dsp_data->n_A=n_val;
dsp_data->n_IA1=n_indx;
dsp_data->n_PB=n_pntrb;
dsp_data->n_PE=n_pntre;
dsp_data->n_BP1=0;
dsp_data->n_BP2=0;
dsp_data->n_IA2=0;
if(options>0) {//then
// decision rule whether or not to copy
COPY=TRUE;
if(COPY) {//then
options=-1; //copy
}else{
options=0; //reference
}//end if
}//end if
if (options==0) {//then
set_infoa(dsp_data->INFOA,'c',REF_OF_SOURCE,istat);
if (*istat!=0) {
*istat=blas_error_param;
return NULL;
}
// create reference to original matrix
dsp_data->A=val;
dsp_data->IA1=indx;
dsp_data->PB=pntrb;
dsp_data->PE=pntre;
*istat=0;
}else{
// The additional required memory is DEALLOCATED later in USDS//
set_infoa(dsp_data->INFOA,'c',COP_OF_SOURCE,istat);
if (*istat!=0) {//
*istat=blas_error_param;
return NULL;
}
// copy original data
dsp_data->A=(double*)aligned_malloc(sizeof(double)*n_val);
dsp_data->IA1=(int*)aligned_malloc(sizeof(int)*n_indx);
dsp_data->PB=(int*)aligned_malloc(sizeof(int)*n_pntrb);
dsp_data->PE=(int*)aligned_malloc(sizeof(int)*n_pntre);
if (*istat!=0) {//
*istat=blas_error_memalloc;
return NULL;
}
for(i=0;i<dsp_data->n_A;i++)
dsp_data->A[i]=val[i];
for(i=0;i<dsp_data->n_IA1;i++)
dsp_data->IA1[i]=indx[i];
for(i=0;i<dsp_data->n_PB;i++)
dsp_data->PB[i]=pntrb[i];
for(i=0;i<dsp_data->n_PE;i++)
dsp_data->PE[i]=pntre[i];
*istat=1;
}
if(*istat>=0)
{
*istat=0;
return dsp_l;
}
else
return NULL;
}
// **********************************************************************
// Author : luoyulong
// Date of last modification : 7.7.00
// Description : PERFORMS MV MULT. WITH MATRIX IN 'BSR'-STORAGE
// rmbv = Right Multiplication By Vector: y=Ax
// **********************************************************************
void drmbv_bsr (DSPMAT* mat,double* x,int n,double* y,int m,int* ierr)
{
int base,ofs,bofs,i,pntr,mm,nn,mb,nb,nn_sq;
char diag,type,part,store;
int aa,xx,yy;
*ierr = -1;
get_infoa(mat->INFOA,'b',&base,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
ofs=base;
bofs=-base;
get_infoa(mat->INFOA,'d',&mm,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'e',&nn,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'f',&mb,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_infoa(mat->INFOA,'g',&nb,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'d',&diag,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'f',&store,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'t',&type,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
get_descra(mat->DESCRA,'a',&part,ierr);
if (*ierr!=0) {
*ierr = blas_error_param;
return;
}
if ((mat->FIDA!=BSR_FORMAT)||(mat->M!=m)||(mat->K!=n)||(mm!=nn)) {
*ierr = blas_error_param;
return;
}
memset (y,0,sizeof(double)*m);
nn_sq = nn*nn;
if (diag=='U') { //process unstored diagonal
if (m==n) {
memcpy (y,x,sizeof(double)*m);;
}else{
*ierr = blas_error_param;
return;
}
}
if ((type=='S')&&(!(part=='B'))&&(m==n))
{
if (part=='U')//Upper
{
for(i=0;i<mb;i++)
{
pntr = mat->PB[i];
while(pntr<mat->PE[i])
{
if(i==mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
else if (i<mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(pntr+bofs)*nn_sq;
xx=i*nn;
yy=(mat->IA1[pntr+ofs]+bofs)*nn;
dblock_T_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
pntr++;
}
}
}
else{//lower
for(i=0;i<mb;i++)
{
pntr = mat->PB[i];
while(pntr<mat->PE[i])
{
if(i==mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
else if (i>mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(pntr+bofs)*nn_sq;
xx=i*nn;
yy=(mat->IA1[pntr+ofs]+bofs)*nn;
dblock_T_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
pntr++;
}
}
}
*ierr = 0;
}
else if((type=='H')&&(!(part=='B'))&&(m==n)) {
if (part=='U')
{
for(i=0;i<mb;i++)
{
pntr = mat->PB[i];
while(pntr<mat->PE[i])
{
if(i==mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
else if (i<mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(pntr+bofs)*nn_sq;
xx=i*nn;
yy=(mat->IA1[pntr+ofs]+bofs)*nn;
dblock_H_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
pntr++;
}
}
}
else{//lower
for(i=0;i<mb;i++)
{
pntr = mat->PB[i];
while(pntr<mat->PE[i])
{
if(i==mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
else if (i>mat->IA1[pntr+ofs] + ofs)
{
aa=(pntr+bofs)*nn_sq;
xx=(mat->IA1[pntr+ofs]+bofs)*nn;
yy=i*nn;
dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
aa=(pntr+bofs)*nn_sq;
xx=i*nn;
yy=(mat->IA1[pntr+ofs]+bofs)*nn;
dblock_H_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
}
pntr++;
}
}
}
*ierr = 0;
}
else{ //no symmetry
// #pragma omp parallel for num_threads(dtn(mb,MIN_ITERATOR_NUM))
// for(i=0;i<mb;i++)
// {
// int row_begin = mat->PB[i];
// int row_end = mat->PE[i];
// int j;
// for(j=row_begin;j<row_end;j++)
// {
// int p=0;
// //dblock_mult_vec(&mat->A[aa],&x[xx],nn,&y[yy],nn,store,ierr);
// for (p=0;p<nn;p++){
// int q=0;
// for(q=0;q<nn;q++){
// if((i*nn+p < mat->M) && (mat->IA1[j]*nn+q < mat->K)){
// y[i*nn+p]+=mat->A[j*nn*nn+p*nn+q]*x[mat->IA1[j]*nn+q];
// }
// }
// }
// }
// }
rmbv_bsr(mat->IA1,mat->A,mat->PB,mat->PE,mb,nb,mat->M,mat->K,mat->n_IA1,nn,x,y);
*ierr = 0;
}
}// drmbv_bsr