LIS_INT lis_matrix_malloc_csr(LIS_INT n, LIS_INT nnz, LIS_INT **ptr, LIS_INT **index, LIS_SCALAR **value)
{
LIS_DEBUG_FUNC_IN;
*ptr = NULL;
*index = NULL;
*value = NULL;
*ptr = (LIS_INT *)lis_malloc( (n+1)*sizeof(LIS_INT),"lis_matrix_malloc_csr::ptr" );
if( *ptr==NULL )
{
LIS_SETERR_MEM((n+1)*sizeof(LIS_INT));
lis_free2(3,*ptr,*index,*value);
return LIS_OUT_OF_MEMORY;
}
*index = (LIS_INT *)lis_malloc( nnz*sizeof(LIS_INT),"lis_matrix_malloc_csr::index" );
if( *index==NULL )
{
LIS_SETERR_MEM(nnz*sizeof(LIS_INT));
lis_free2(3,*ptr,*index,*value);
return LIS_OUT_OF_MEMORY;
}
*value = (LIS_SCALAR *)lis_malloc( nnz*sizeof(LIS_SCALAR),"lis_matrix_malloc_csr::value" );
if( *value==NULL )
{
LIS_SETERR_MEM(nnz*sizeof(LIS_SCALAR));
lis_free2(3,*ptr,*index,*value);
return LIS_OUT_OF_MEMORY;
}
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_matrix_ilu_setVR(LIS_MATRIX_ILU A)
{
LIS_INT n;
LIS_INT *bsz;
LIS_SCALAR ***values;
LIS_DEBUG_FUNC_IN;
n = A->n;
bsz = (LIS_INT *)lis_malloc( n*sizeof(LIS_INT),"lis_matrix_ilu_setVR::bsz" );
if( bsz==NULL )
{
LIS_SETERR_MEM(n*sizeof(LIS_INT));
return LIS_OUT_OF_MEMORY;
}
values = (LIS_SCALAR ***)lis_malloc( n*sizeof(LIS_SCALAR **),"lis_matrix_ilu_setVR::values" );
if( values==NULL )
{
LIS_SETERR_MEM(n*sizeof(LIS_SCALAR *));
return LIS_OUT_OF_MEMORY;
}
A->bsz = bsz;
A->values = values;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_arg2args(LIS_INT argc, char *argv[], LIS_ARGS *args)
{
char *p;
LIS_INT i,k1,k2;
LIS_ARGS arg_top,arg;
LIS_DEBUG_FUNC_IN;
arg_top = (LIS_ARGS)lis_malloc(sizeof(struct LIS_ARGS_STRUCT),"lis_arg2args::arg_top");
arg_top->next = arg_top;
arg_top->prev = arg_top;
arg_top->arg1 = NULL;
arg_top->arg2 = NULL;
i = 1;
while( i<argc )
{
if( argv[i][0]=='-' && (i+1)<argc )
{
k1 = (LIS_INT)strlen(argv[i]);
k2 = (LIS_INT)strlen(argv[i+1]);
arg = (LIS_ARGS)lis_malloc(sizeof(struct LIS_ARGS_STRUCT),"lis_arg2args::arg");
arg->arg1 = (char *)lis_malloc((k1+1)*sizeof(char),"lis_arg2args::arg->arg1");
arg->arg2 = (char *)lis_malloc((k2+1)*sizeof(char),"lis_arg2args::arg->arg2");
arg->next = arg_top;
arg->prev = arg_top->prev;
arg->prev->next = arg;
arg->next->prev = arg;
strcpy(arg->arg1,argv[i]);
strcpy(arg->arg2,argv[i+1]);
p = arg->arg1;
while( *p!='\0' )
{
*p = (char)tolower(*p);
p++;
}
p = arg->arg2;
while( *p!='\0' )
{
*p = (char)tolower(*p);
p++;
}
i += 2;
}
else
{
i++;
}
}
*args = arg_top;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_matrix_ilu_create(LIS_INT n, LIS_INT bs, LIS_MATRIX_ILU *A)
{
LIS_INT i;
LIS_INT *nnz;
LIS_INT **index;
LIS_DEBUG_FUNC_IN;
*A = NULL;
nnz = NULL;
index = NULL;
*A = (LIS_MATRIX_ILU)lis_malloc( sizeof(struct LIS_MATRIX_ILU_STRUCT),"lis_matrix_ilu_create::A" );
if( NULL==*A )
{
LIS_SETERR_MEM(sizeof(struct LIS_MATRIX_ILU_STRUCT));
return LIS_OUT_OF_MEMORY;
}
memset(*A,0,sizeof(struct LIS_MATRIX_ILU_STRUCT));
nnz = (LIS_INT *)lis_malloc( n*sizeof(LIS_INT),"lis_matrix_ilu_create::nnz" );
if( nnz==NULL )
{
LIS_SETERR_MEM(n*sizeof(LIS_INT));
return LIS_OUT_OF_MEMORY;
}
index = (LIS_INT **)lis_malloc( n*sizeof(LIS_INT *),"lis_matrix_ilu_create::index" );
if( index==NULL )
{
LIS_SETERR_MEM(n*sizeof(LIS_INT *));
return LIS_OUT_OF_MEMORY;
}
#ifdef _OPENMP
#pragma omp parallel for private(i)
#endif
for(i=0;i<n;i++)
{
nnz[i] = 0;
index[i] = NULL;
}
(*A)->n = n;
(*A)->bs = bs;
(*A)->nnz = nnz;
(*A)->index = index;
(*A)->nnz_ma = NULL;
(*A)->value = NULL;
(*A)->values = NULL;
(*A)->bsz = NULL;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_vector_reuse(LIS_VECTOR *vec)
{
LIS_INT err,np,precision;
LIS_DEBUG_FUNC_IN;
err = lis_vector_check(*vec,LIS_VECTOR_CHECK_NULL);
if( err ) return err;
np = (*vec)->np;
if( (*vec)->status==LIS_VECTOR_NULL )
{
precision = ((LIS_VECTOR)*vec)->precision;
if( !precision )
{
(*vec)->value = (LIS_SCALAR *)lis_malloc( np*sizeof(LIS_SCALAR),"lis_vector_reuse::vec->value" );
if( NULL==(*vec)->value )
{
LIS_SETERR_MEM(np*sizeof(LIS_SCALAR));
return LIS_OUT_OF_MEMORY;
}
(*vec)->is_copy = LIS_TRUE;
}
else
{
(*vec)->value = (LIS_SCALAR *)lis_malloc( (2*np+np%2)*sizeof(LIS_SCALAR),"lis_vector_reuse::vec->value" );
if( NULL==(*vec)->value )
{
LIS_SETERR_MEM((2*np+np%2)*sizeof(LIS_SCALAR));
return LIS_OUT_OF_MEMORY;
}
(*vec)->is_copy = LIS_TRUE;
(*vec)->value_lo = (*vec)->value + np + np%2;
(*vec)->work = (LIS_SCALAR *)lis_malloc( 32*sizeof(LIS_SCALAR),"lis_vector_reuse::vec->work" );
if( NULL==(*vec)->work )
{
LIS_SETERR_MEM(32*sizeof(LIS_SCALAR));
lis_vector_destroy(*vec);
*vec = NULL;
return LIS_OUT_OF_MEMORY;
}
}
}
(*vec)->status = LIS_VECTOR_ASSEMBLED;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
void lis_sort_jad(LIS_INT is, LIS_INT ie, LIS_INT maxnzr, LIS_INT *i1, LIS_INT *i2)
{
LIS_INT i,j;
LIS_INT *iw,*iw2;
iw = (LIS_INT *)lis_malloc((maxnzr+2)*sizeof(LIS_INT),"lis_sort_jad::iw");
iw2 = (LIS_INT *)lis_malloc((maxnzr+2)*sizeof(LIS_INT),"lis_sort_jad::iw2");
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<maxnzr+2;i++)
{
iw[i] = 0;
}
for(i=is;i<ie;i++)
{
iw[(maxnzr - i1[i])+1]++;
}
iw[0] = is;
for(i=0;i<maxnzr+1;i++)
{
iw[i+1] += iw[i];
}
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<maxnzr+2;i++)
{
iw2[i] = iw[i];
}
for(i=is;i<ie;i++)
{
i2[iw[maxnzr - i1[i]]] = i;
iw[maxnzr - i1[i]]++;
}
for(i=0;i<maxnzr+1;i++)
{
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(j=iw2[i];j<iw2[i+1];j++)
{
i1[j] = maxnzr - i;
}
}
lis_free2(2,iw,iw2);
}
void lis_sort_jds(int is, int ie, int maxnzr, int *i1, int *i2)
{
int i,j;
int *iw,*iw2;
iw = (int *)lis_malloc((maxnzr+2)*sizeof(int),"lis_sort_jds::iw");
iw2 = (int *)lis_malloc((maxnzr+2)*sizeof(int),"lis_sort_jds::iw2");
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<maxnzr+2;i++)
{
iw[i] = 0;
}
for(i=is;i<ie;i++)
{
iw[(maxnzr - i1[i])+1]++;
}
iw[0] = is;
for(i=0;i<maxnzr+1;i++)
{
iw[i+1] += iw[i];
}
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<maxnzr+2;i++)
{
iw2[i] = iw[i];
}
for(i=is;i<ie;i++)
{
i2[iw[maxnzr - i1[i]]] = i;
iw[maxnzr - i1[i]]++;
}
for(i=0;i<maxnzr+1;i++)
{
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(j=iw2[i];j<iw2[i+1];j++)
{
i1[j] = maxnzr - i;
}
}
lis_free2(2,iw,iw2);
}
void lis_set_argv_f(LIS_INT *no, char *argv, LIS_INT *ierr, LIS_INT len)
{
LIS_INT i;
char *p;
LIS_DEBUG_FUNC_IN;
i = *no;
f_argv_tmp[i] = (char *)lis_malloc((len+1)*sizeof(char),"lis_set_argv_f::f_argv_tmp");
if( f_argv_tmp[i]==NULL )
{
LIS_SETERR_MEM((len+1)*sizeof(char));
*ierr = LIS_OUT_OF_MEMORY;
return;
}
memset(f_argv_tmp[i],0x20,(len+1)*sizeof(char));
strncpy(f_argv_tmp[i],argv,len);
p = &f_argv_tmp[i][len];
if( len>0 )
{
while( *p==' ' ) p--;
p++;
}
*p = '\0';
*ierr = LIS_SUCCESS;
LIS_DEBUG_FUNC_OUT;
return;
}
LIS_INT lis_precon_register(char *name, LIS_PRECON_CREATE_XXX pcreate, LIS_PSOLVE_XXX psolve, LIS_PSOLVET_XXX psolvet)
{
LIS_DEBUG_FUNC_IN;
if( precon_register_top==NULL )
{
precon_register_top = (LIS_PRECON_REGISTER *)lis_malloc(LIS_PRECON_REGISTER_MAX*sizeof(struct LIS_PRECON_REGISTER_STRUCT),"lis_precon_register::precon_register_top");
}
if( precon_register_type-LIS_PRECON_TYPE_USERDEF==LIS_PRECON_REGISTER_MAX )
{
LIS_SETERR(LIS_FAILS,"lis_precon_resister is max\n");
return LIS_FAILS;
}
precon_register_top[precon_register_type-LIS_PRECON_TYPE_USERDEF].pcreate = pcreate;
precon_register_top[precon_register_type-LIS_PRECON_TYPE_USERDEF].psolve = psolve;
precon_register_top[precon_register_type-LIS_PRECON_TYPE_USERDEF].psolvet = psolvet;
precon_register_top[precon_register_type-LIS_PRECON_TYPE_USERDEF].precon_type = precon_register_type;
strncpy(precon_register_top[precon_register_type-LIS_PRECON_TYPE_USERDEF].name,name,LIS_PRECONNAME_MAX);
precon_register_top[precon_register_type-LIS_PRECON_TYPE_USERDEF].name[LIS_PRECONNAME_MAX] = '\0';
precon_register_type++;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_precon_create_adds(LIS_SOLVER solver, LIS_PRECON precon)
{
LIS_INT i,j;
LIS_INT precon_type,worklen;
LIS_INT err;
LIS_VECTOR *work;
LIS_DEBUG_FUNC_IN;
precon_type = solver->options[LIS_OPTIONS_PRECON];
worklen = 2;
work = (LIS_VECTOR *)lis_malloc( worklen*sizeof(LIS_VECTOR),"lis_precon_create_adds::work" );
if( work==NULL )
{
LIS_SETERR_MEM(worklen*sizeof(LIS_VECTOR));
return LIS_OUT_OF_MEMORY;
}
if( solver->precision==LIS_PRECISION_DEFAULT )
{
for(i=0;i<worklen;i++)
{
err = lis_vector_duplicate(solver->A,&work[i]);
if( err ) break;
}
}
else
{
for(i=0;i<worklen;i++)
{
err = lis_vector_duplicateex(LIS_PRECISION_QUAD,solver->A,&work[i]);
if( err ) break;
}
}
if( i<worklen )
{
for(j=0;j<i;j++) lis_vector_destroy(work[j]);
lis_free(work);
return err;
}
precon->worklen = worklen;
precon->work = work;
err = lis_precon_create_xxx[precon_type](solver,precon);
if( err )
{
lis_precon_destroy(precon);
return err;
}
precon->A = solver->A;
precon->is_copy = LIS_FALSE;
LIS_DEBUG_FUNC_OUT;
return err;
}
LIS_INT lis_gmres_malloc_work(LIS_SOLVER solver)
{
LIS_VECTOR *work;
LIS_INT i,j,restart,worklen,err;
LIS_DEBUG_FUNC_IN;
restart = solver->options[LIS_OPTIONS_RESTART];
worklen = NWORK + (restart+1);
work = (LIS_VECTOR *)lis_malloc( worklen*sizeof(LIS_VECTOR),"lis_gmres_malloc_work::work" );
if( work==NULL )
{
LIS_SETERR_MEM(worklen*sizeof(LIS_VECTOR));
return LIS_ERR_OUT_OF_MEMORY;
}
if( solver->precision==LIS_PRECISION_DEFAULT )
{
for(i=1;i<worklen;i++)
{
err = lis_vector_duplicate(solver->A,&work[i]);
if( err ) break;
}
}
else
{
for(i=1;i<worklen;i++)
{
err = lis_vector_duplicateex(LIS_PRECISION_QUAD,solver->A,&work[i]);
if( err ) break;
memset(work[i]->value_lo,0,solver->A->np*sizeof(LIS_SCALAR));
}
}
if( i<worklen )
{
for(j=1;j<i;j++) lis_vector_destroy(work[j]);
lis_free(work);
return err;
}
if( solver->precision==LIS_PRECISION_DEFAULT )
{
lis_vector_create(solver->A->comm,&work[0]);
}
else
{
lis_vector_createex(LIS_PRECISION_QUAD,solver->A->comm,&work[0]);
}
lis_vector_set_size(work[0],restart+1,0);
solver->worklen = worklen;
solver->work = work;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
int lis_vector_scatter(LIS_SCALAR value[], LIS_VECTOR v)
{
#ifdef USE_MPI
int err,i,is,n,my_rank,nprocs,*sendcounts;
err = lis_vector_check(v,LIS_VECTOR_CHECK_NULL);
if( err ) return err;
my_rank = v->my_rank;
nprocs = v->nprocs;
n = v->n;
is = v->is;
sendcounts = (int *)lis_malloc( (nprocs+1)*sizeof(int),"lis_vector_scatter::sendcounts" );
for(i=0; i<nprocs; i++)
{
sendcounts[i] = v->ranges[i+1] - v->ranges[i];
}
MPI_Scatterv(&value[0],sendcounts,v->ranges,MPI_DOUBLE,&value[is],n,MPI_DOUBLE,0,v->comm);
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
#ifdef _OPENMP
#pragma omp parallel for private(i)
#endif
for(i=0; i<n; i++)
{
v->value[i] = value[i+is];
}
return LIS_SUCCESS;
#else
int err,i,n;
err = lis_vector_check(v,LIS_VECTOR_CHECK_NULL);
if( err ) return err;
n = v->n;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
#ifdef _OPENMP
#pragma omp parallel for private(i)
#endif
for(i=0; i<n; i++)
{
v->value[i] = value[i];
}
return LIS_SUCCESS;
#endif
}
LIS_INT lis_idrs_malloc_work(LIS_SOLVER solver)
{
LIS_VECTOR *work;
LIS_INT i,j,s,worklen,err;
LIS_DEBUG_FUNC_IN;
/*
err = lis_matrix_convert(solver->A,&solver->At,LIS_MATRIX_CCS);
if( err ) return err;
*/
s = solver->options[LIS_OPTIONS_IDRS_RESTART];
worklen = NWORK + 3*s;
work = (LIS_VECTOR *)lis_malloc(
worklen*sizeof(LIS_VECTOR),"lis_idrs_malloc_work::work" );
if( work==NULL )
{
LIS_SETERR_MEM(worklen*sizeof(LIS_VECTOR));
return LIS_ERR_OUT_OF_MEMORY;
}
if( solver->precision==LIS_PRECISION_DEFAULT )
{
for(i=0;i<worklen;i++)
{
err = lis_vector_duplicate(solver->A,&work[i]);
if( err ) break;
}
}
else
{
for(i=0;i<worklen;i++)
{
err =
lis_vector_duplicateex(LIS_PRECISION_QUAD,solver->A,&work[i]);
if( err ) break;
memset(work[i]->value_lo,0,solver->A->np*sizeof(LIS_SCALAR));
}
}
if( i<worklen )
{
for(j=0;j<i;j++) lis_vector_destroy(work[j]);
lis_free(work);
return err;
}
solver->worklen = worklen;
solver->work = work;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_vector_gather(LIS_VECTOR v, LIS_SCALAR value[])
{
#ifdef USE_MPI
LIS_INT err,i,is,n,nprocs,*recvcounts;
err = lis_vector_check(v,LIS_VECTOR_CHECK_NULL);
if( err ) return err;
nprocs = v->nprocs;
n = v->n;
is = v->is;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
#ifdef _OPENMP
#pragma omp parallel for private(i)
#endif
for(i=0; i<n; i++)
{
value[i+is] = v->value[i];
}
recvcounts = (LIS_INT *)lis_malloc( (nprocs+1)*sizeof(LIS_INT),"lis_vector_gather::recvcounts" );
for(i=0; i<nprocs; i++)
{
recvcounts[i] = v->ranges[i+1] - v->ranges[i];
}
MPI_Allgatherv(&value[is],n,MPI_DOUBLE,&value[0],recvcounts,v->ranges,MPI_DOUBLE,v->comm);
return LIS_SUCCESS;
#else
LIS_INT err,i,n;
err = lis_vector_check(v,LIS_VECTOR_CHECK_NULL);
if( err ) return err;
n = v->n;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
#ifdef _OPENMP
#pragma omp parallel for private(i)
#endif
for(i=0; i<n; i++)
{
value[i] = v->value[i];
}
return LIS_SUCCESS;
#endif
}
LIS_INT lis_quad_malloc(LIS_QUAD_PTR *a, LIS_INT n)
{
double *ah, *al;
LIS_DEBUG_FUNC_IN;
ah = (double *)lis_malloc(2*n*sizeof(double),"lis_quad_malloc::ah");
al = &ah[n];
a->hi = ah;
a->lo = al;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_matrix_malloc_dia(LIS_INT n, LIS_INT nnd, LIS_INT **index, LIS_SCALAR **value)
{
LIS_DEBUG_FUNC_IN;
*index = NULL;
*value = NULL;
*index = (LIS_INT *)lis_malloc( n*nnd*sizeof(LIS_INT),"lis_matrix_malloc_dia::index" );
if( *index==NULL )
{
LIS_SETERR_MEM(n*nnd*sizeof(LIS_INT));
lis_free2(2,*index,*value);
return LIS_OUT_OF_MEMORY;
}
*value = (LIS_SCALAR *)lis_malloc( n*nnd*sizeof(LIS_SCALAR),"lis_matrix_malloc_dia::value" );
if( *value==NULL )
{
LIS_SETERR_MEM(n*nnd*sizeof(LIS_SCALAR));
lis_free2(2,*index,*value);
return LIS_OUT_OF_MEMORY;
}
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
int lis_vector_set_value(int flag, int i, LIS_SCALAR value, LIS_VECTOR v)
{
int n,np,gn,is,ie;
LIS_DEBUG_FUNC_IN;
np = v->np;
n = v->n;
gn = v->gn;
is = v->is;
ie = v->ie;
if( v->origin ) i--;
if( i<is || i>=ie )
{
if( v->origin )
{
is++;
ie++;
i++;
}
LIS_SETERR3(LIS_ERR_ILL_ARG, "i(=%d) is less than %d or larger than %d\n",i,is,ie);
return LIS_ERR_ILL_ARG;
}
if(v->status==LIS_VECTOR_NULL)
{
v->value = (LIS_SCALAR *)lis_malloc( np*sizeof(LIS_SCALAR),"lis_vector_set_value::v->value" );
if( NULL==v->value )
{
LIS_SETERR_MEM(np*sizeof(LIS_SCALAR));
return LIS_OUT_OF_MEMORY;
}
v->is_copy = LIS_TRUE;
v->status = LIS_VECTOR_ASSEMBLING;
}
if(flag==LIS_INS_VALUE)
{
v->value[i-is] = value;
}
else
{
v->value[i-is] += value;
}
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
void lis_set_argv_begin_f(LIS_INT *argc, LIS_INT *ierr)
{
LIS_DEBUG_FUNC_IN;
f_argc_tmp = *argc+1;
f_argv_tmp = (char **)lis_malloc(f_argc_tmp*sizeof(char *),"lis_set_argv_begin_f::f_argv_tmp");
if( f_argv_tmp==NULL )
{
LIS_SETERR_MEM(f_argc_tmp*sizeof(char *));
*ierr = LIS_OUT_OF_MEMORY;
return;
}
*ierr = LIS_SUCCESS;
LIS_DEBUG_FUNC_OUT;
return;
}
LIS_INT lis_solver_create(LIS_SOLVER *solver)
{
LIS_DEBUG_FUNC_IN;
*solver = NULL;
*solver = (LIS_SOLVER)lis_malloc( sizeof(struct LIS_SOLVER_STRUCT),"lis_solver_create::solver" );
if( NULL==*solver )
{
LIS_SETERR_MEM(sizeof(struct LIS_SOLVER_STRUCT));
return LIS_OUT_OF_MEMORY;
}
lis_solver_init(*solver);
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_input_hb(LIS_MATRIX A, LIS_VECTOR b, LIS_VECTOR x, FILE *file)
{
LIS_INT err;
LIS_INT matrix_type;
LIS_MATRIX B;
LIS_DEBUG_FUNC_IN;
matrix_type = A->matrix_type;
err = lis_input_hb_csr(A,b,x,file);
if( err ) return err;
if( matrix_type!=LIS_MATRIX_CSR && matrix_type!=LIS_MATRIX_CSC )
{
err = lis_matrix_duplicate(A,&B);
if( err ) return err;
lis_matrix_set_type(B,matrix_type);
err = lis_matrix_convert(A,B);
if( err ) return err;
lis_matrix_storage_destroy(A);
lis_matrix_DLU_destroy(A);
lis_matrix_diag_destroy(A->WD);
if( A->l2g_map ) lis_free( A->l2g_map );
if( A->commtable ) lis_commtable_destroy( A->commtable );
if( A->ranges ) lis_free( A->ranges );
err = lis_matrix_copy_struct(B,A);
if( err ) return err;
lis_free(B);
if( A->matrix_type==LIS_MATRIX_JAD )
{
A->work = (LIS_SCALAR *)lis_malloc(A->n*sizeof(LIS_SCALAR),"lis_input_hb::A->work");
if( A->work==NULL )
{
LIS_SETERR_MEM(A->n*sizeof(LIS_SCALAR));
return LIS_OUT_OF_MEMORY;
}
}
}
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_esi_malloc_work(LIS_ESOLVER esolver)
{
LIS_VECTOR *work;
LIS_INT i,j,worklen,err,ss;
LIS_DEBUG_FUNC_IN;
ss = esolver->options[LIS_EOPTIONS_SUBSPACE];
worklen = NWORK + ss;
work = (LIS_VECTOR *)lis_malloc( worklen*sizeof(LIS_VECTOR),"lis_esi_malloc_work::work" );
if( work==NULL )
{
LIS_SETERR_MEM(worklen*sizeof(LIS_VECTOR));
return LIS_ERR_OUT_OF_MEMORY;
}
if( esolver->eprecision==LIS_PRECISION_DEFAULT )
{
for(i=0;i<worklen;i++)
{
err = lis_vector_duplicate(esolver->A,&work[i]);
if( err ) break;
}
}
else
{
for(i=0;i<worklen;i++)
{
err = lis_vector_duplicateex(LIS_PRECISION_QUAD,esolver->A,&work[i]);
if( err ) break;
}
}
if( i<worklen )
{
for(j=0;j<i;j++) lis_vector_destroy(work[j]);
lis_free(work);
return err;
}
esolver->worklen = worklen;
esolver->work = work;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_matrix_ilu_premalloc(LIS_INT nnzrow, LIS_MATRIX_ILU A)
{
LIS_INT i,n;
LIS_INT *nnz_ma;
LIS_DEBUG_FUNC_IN;
n = A->n;
nnz_ma = (LIS_INT *)lis_malloc( n*sizeof(LIS_INT),"lis_matrix_ilu_premalloc::nnz_ma" );
if( nnz_ma==NULL )
{
LIS_SETERR_MEM(n*sizeof(LIS_INT));
return LIS_OUT_OF_MEMORY;
}
#ifdef _OPENMP
#pragma omp parallel for private(i)
#endif
for(i=0;i<n;i++)
{
nnz_ma[i] = nnzrow;
A->index[i] = (LIS_INT *)malloc( nnzrow*sizeof(LIS_INT) );
A->value[i] = (LIS_SCALAR *)malloc( nnzrow*sizeof(LIS_SCALAR) );
}
for(i=0;i<n;i++)
{
if( A->index[i]==NULL )
{
LIS_SETERR_MEM(nnzrow*sizeof(LIS_INT));
return LIS_OUT_OF_MEMORY;
}
if( A->value[i]==NULL )
{
LIS_SETERR_MEM(nnzrow*sizeof(LIS_SCALAR));
return LIS_OUT_OF_MEMORY;
}
}
A->nnz_ma = nnz_ma;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_cgs_malloc_work(LIS_SOLVER solver)
{
LIS_VECTOR *work;
LIS_INT i,j,worklen,err;
LIS_DEBUG_FUNC_IN;
worklen = NWORK;
work = (LIS_VECTOR *)lis_malloc( worklen*sizeof(LIS_VECTOR),"lis_cgs_malloc_work::work" );
if( work==NULL )
{
LIS_SETERR_MEM(worklen*sizeof(LIS_VECTOR));
return LIS_ERR_OUT_OF_MEMORY;
}
if( solver->precision==LIS_PRECISION_DEFAULT )
{
for(i=0;i<worklen;i++)
{
err = lis_vector_duplicate(solver->A,&work[i]);
if( err ) break;
}
}
else
{
for(i=0;i<worklen;i++)
{
err = lis_vector_duplicateex(LIS_PRECISION_QUAD,solver->A,&work[i]);
if( err ) break;
memset(work[i]->value_lo,0,solver->A->np*sizeof(LIS_SCALAR));
}
}
if( i<worklen )
{
for(j=0;j<i;j++) lis_vector_destroy(work[j]);
lis_free(work);
return err;
}
solver->worklen = worklen;
solver->work = work;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_matrix_ilu_setCR(LIS_MATRIX_ILU A)
{
LIS_INT n;
LIS_SCALAR **value;
LIS_DEBUG_FUNC_IN;
n = A->n;
value = (LIS_SCALAR **)lis_malloc( n*sizeof(LIS_SCALAR *),"lis_matrix_ilu_setCR::value" );
if( value==NULL )
{
LIS_SETERR_MEM(n*sizeof(LIS_SCALAR));
return LIS_OUT_OF_MEMORY;
}
A->value = value;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_precon_create(LIS_SOLVER solver, LIS_PRECON *precon)
{
LIS_INT err;
LIS_INT precon_type;
LIS_DEBUG_FUNC_IN;
*precon = NULL;
precon_type = solver->options[LIS_OPTIONS_PRECON];
*precon = (LIS_PRECON)lis_malloc( sizeof(struct LIS_PRECON_STRUCT),"lis_precon_create::precon" );
if( NULL==*precon )
{
LIS_SETERR_MEM(sizeof(struct LIS_PRECON_STRUCT));
return LIS_OUT_OF_MEMORY;
}
lis_precon_init(*precon);
(*precon)->precon_type = precon_type;
if( precon_type>=LIS_PRECON_TYPE_USERDEF )
{
err = precon_register_top[precon_type-LIS_PRECON_TYPE_USERDEF].pcreate(solver,*precon);
}
else if( precon_type && solver->options[LIS_OPTIONS_ADDS] )
{
err = lis_precon_create_adds(solver,*precon);
(*precon)->precon_type = LIS_PRECON_TYPE_ADDS;
}
else
{
err = lis_precon_create_xxx[precon_type](solver,*precon);
}
if( err )
{
lis_precon_destroy(*precon);
return err;
}
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_vector_createex(LIS_INT precision, LIS_Comm comm, LIS_VECTOR *vec)
{
LIS_DEBUG_FUNC_IN;
*vec = NULL;
*vec = (LIS_VECTOR)lis_malloc( sizeof(struct LIS_VECTOR_STRUCT),"lis_vector_createex::vec" );
if( NULL==*vec )
{
LIS_SETERR_MEM(sizeof(struct LIS_VECTOR_STRUCT));
return LIS_OUT_OF_MEMORY;
}
lis_vector_init(vec);
(*vec)->status = LIS_VECTOR_NULL;
(*vec)->precision = precision;
(*vec)->comm = comm;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_orthomin_quad(LIS_SOLVER solver)
{
LIS_Comm comm;
LIS_MATRIX A;
LIS_PRECON M;
LIS_VECTOR x;
LIS_VECTOR r, rtld, *p, *ap, *aptld;
LIS_QUAD *dotsave;
LIS_QUAD_PTR alpha, beta, tmp, one;
LIS_REAL bnrm2, nrm2, tol;
LIS_INT iter,maxiter,output,conv;
double time,ptime;
LIS_INT m,l,lmax,ip,ip0;
LIS_DEBUG_FUNC_IN;
comm = LIS_COMM_WORLD;
A = solver->A;
M = solver->precon;
x = solver->x;
maxiter = solver->options[LIS_OPTIONS_MAXITER];
output = solver->options[LIS_OPTIONS_OUTPUT];
m = solver->options[LIS_OPTIONS_RESTART];
conv = solver->options[LIS_OPTIONS_CONV_COND];
ptime = 0.0;
LIS_QUAD_SCALAR_MALLOC(alpha,0,1);
LIS_QUAD_SCALAR_MALLOC(beta,1,1);
LIS_QUAD_SCALAR_MALLOC(tmp,3,1);
LIS_QUAD_SCALAR_MALLOC(one,4,1);
r = solver->work[0];
rtld = solver->work[1];
p = &solver->work[2];
ap = &solver->work[ (m+1)+2];
aptld = &solver->work[2*(m+1)+2];
one.hi[0] = 1.0;
one.lo[0] = 0.0;
dotsave = (LIS_QUAD *)lis_malloc( sizeof(LIS_QUAD) * (m+1),"lis_orthomin_quad::dotsave" );
/* Initial Residual */
if( lis_solver_get_initial_residual(solver,M,r,rtld,&bnrm2) )
{
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
tol = solver->tol;
iter=1;
while( iter<=maxiter )
{
ip = (iter-1) % (m+1);
/* p[ip] = rtld */
lis_vector_copyex_mm(rtld,p[ip]);
/* ap[ip] = A*p[ip] */
/* aptld[ip] = M^-1 ap[ip] */
lis_matvec(A,p[ip],ap[ip]);
time = lis_wtime();
lis_psolve(solver, ap[ip], aptld[ip]);
ptime += lis_wtime()-time;
lmax = _min(m,iter-1);
for(l=1;l<=lmax;l++)
{
ip0 = (ip+m+1-l) % (m+1);
/* beta = -<Ar[ip],Ap[ip0]> / <Ap[ip0],Ap[ip0]> */
lis_vector_dotex_mmm(aptld[ip],aptld[ip0],&beta);
lis_quad_mul((LIS_QUAD *)beta.hi,(LIS_QUAD *)beta.hi,&dotsave[l-1]);
lis_quad_minus((LIS_QUAD *)beta.hi);
lis_vector_axpyex_mmm(beta,p[ip0] ,p[ip]);
lis_vector_axpyex_mmm(beta,ap[ip0] ,ap[ip]);
lis_vector_axpyex_mmm(beta,aptld[ip0],aptld[ip]);
}
for(l=m-1;l>0;l--)
{
dotsave[l] = dotsave[l-1];
}
lis_vector_dotex_mmm(aptld[ip],aptld[ip],&tmp);
dotsave[0].hi = tmp.hi[0];
dotsave[0].lo = tmp.lo[0];
/* test breakdown */
if( tmp.hi[0]==0.0 && tmp.lo[0]==0.0 )
{
solver->retcode = LIS_BREAKDOWN;
solver->iter = iter;
solver->resid = nrm2;
lis_free(dotsave);
LIS_DEBUG_FUNC_OUT;
return LIS_BREAKDOWN;
}
lis_quad_div(&dotsave[0],(LIS_QUAD *)one.hi,&dotsave[0]);
/* alpha = <rtld,Aptld[ip]> */
lis_vector_dotex_mmm(rtld,aptld[ip],&alpha);
lis_quad_mul((LIS_QUAD *)alpha.hi,(LIS_QUAD *)alpha.hi,&dotsave[0]);
lis_vector_axpyex_mmm( alpha,p[ip],x);
lis_quad_minus((LIS_QUAD *)alpha.hi);
lis_vector_axpyex_mmm(alpha,ap[ip],r);
lis_vector_axpyex_mmm(alpha,aptld[ip],rtld);
lis_quad_minus((LIS_QUAD *)alpha.hi);
/* convergence check */
lis_solver_get_residual[conv](r,solver,&nrm2);
if( output )
{
if( output & LIS_PRINT_MEM ) solver->rhistory[iter] = nrm2;
if( output & LIS_PRINT_OUT ) lis_print_rhistory(comm,iter,nrm2);
}
if( tol > nrm2 )
{
solver->retcode = LIS_SUCCESS;
solver->iter = iter;
solver->resid = nrm2;
solver->ptime = ptime;
lis_free(dotsave);
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
iter++;
}
solver->retcode = LIS_MAXITER;
solver->iter = iter;
solver->resid = nrm2;
lis_free(dotsave);
LIS_DEBUG_FUNC_OUT;
return LIS_MAXITER;
}
void lis_matvect_ell(LIS_MATRIX A, LIS_SCALAR x[], LIS_SCALAR y[])
{
LIS_INT i,j,jj;
LIS_INT n,np,maxnzr;
#ifdef _OPENMP
LIS_INT k,is,ie,nprocs;
LIS_SCALAR t;
LIS_SCALAR *w;
#endif
n = A->n;
np = A->np;
if( A->is_splited )
{
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0; i<n; i++)
{
y[i] = A->D->value[i]*x[i];
}
for(j=0;j<A->L->maxnzr;j++)
{
jj = j*n;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<n;i++)
{
y[A->L->index[jj + i]] += A->L->value[jj + i] * x[i];
}
}
for(j=0;j<A->U->maxnzr;j++)
{
jj = j*n;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<n;i++)
{
y[A->U->index[jj + i]] += A->U->value[jj + i] * x[i];
}
}
}
else
{
#ifdef _OPENMP
maxnzr = A->maxnzr;
nprocs = omp_get_max_threads();
w = (LIS_SCALAR *)lis_malloc( nprocs*np*sizeof(LIS_SCALAR),"lis_matvect_ell::w" );
#pragma omp parallel private(i,j,t,jj,k,is,ie)
{
k = omp_get_thread_num();
LIS_GET_ISIE(k,nprocs,n,is,ie);
#pragma omp for
for(j=0;j<nprocs;j++)
{
memset( &w[j*np], 0, np*sizeof(LIS_SCALAR) );
}
for(j=0;j<maxnzr;j++)
{
jj = j*n;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=is;i<ie;i++)
{
w[k*np + A->index[jj + i]] += A->value[jj + i] * x[i];
}
}
#pragma omp barrier
#pragma omp for
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<np;i++)
{
t = 0.0;
for(j=0;j<nprocs;j++)
{
t += w[j*np+i];
}
y[i] = t;
}
}
lis_free(w);
#else
maxnzr = A->maxnzr;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0; i<n; i++)
{
y[i] = 0.0;
}
for(j=0;j<maxnzr;j++)
{
jj = j*n;
#ifdef USE_VEC_COMP
#pragma cdir nodep
#endif
for(i=0;i<n;i++)
{
y[A->index[jj + i]] += A->value[jj + i] * x[i];
}
}
#endif
}
}
LIS_INT lis_ranges_create(LIS_Comm comm, LIS_INT *local_n, LIS_INT *global_n, LIS_INT **ranges, LIS_INT *is, LIS_INT *ie, LIS_INT *nprocs, LIS_INT *my_rank)
{
#ifdef USE_MPI
LIS_INT i;
#endif
LIS_INT *tranges;
int int_nprocs,int_my_rank;
LIS_DEBUG_FUNC_IN;
#ifdef USE_MPI
MPI_Comm_size(comm,&int_nprocs);
MPI_Comm_rank(comm,&int_my_rank);
*nprocs=int_nprocs;
*my_rank=int_my_rank;
tranges = (LIS_INT *)lis_malloc( (*nprocs+1)*sizeof(LIS_INT),"lis_ranges_create::tranges" );
if( tranges==NULL )
{
LIS_SETERR_MEM((*nprocs+1)*sizeof(LIS_INT));
return LIS_OUT_OF_MEMORY;
}
#else
*nprocs = 1;
*my_rank = 0;
tranges = NULL;
#endif
#ifdef USE_MPI
MPI_Allreduce(local_n,&i,1,LIS_MPI_INT,MPI_SUM,comm);
if( i==0 )
#else
if( *local_n==0 )
#endif
{
#ifdef USE_MPI
LIS_GET_ISIE(*my_rank,*nprocs,*global_n,*is,*ie);
*local_n = *ie-*is;
MPI_Allgather(ie,1,LIS_MPI_INT,&tranges[1],1,LIS_MPI_INT,comm);
tranges[0] = 0;
#else
*local_n = *global_n;
*is = 0;
*ie = *global_n;
#endif
}
else
{
#ifdef USE_MPI
MPI_Allgather(local_n,1,LIS_MPI_INT,&tranges[1],1,LIS_MPI_INT,comm);
tranges[0] = 0;
for(i=0;i<*nprocs;i++)
{
tranges[i+1] += tranges[i];
}
*global_n = tranges[*nprocs];
*is = tranges[*my_rank];
*ie = tranges[*my_rank+1];
#else
*global_n = *local_n;
*is = 0;
*ie = *local_n;
#endif
}
*ranges = tranges;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
LIS_INT lis_text2args(char *text, LIS_ARGS *args)
{
char buf[1024];
char *p,*s1,*s2;
LIS_INT k1,k2,f;
LIS_ARGS arg_top,arg;
LIS_DEBUG_FUNC_IN;
arg_top = (LIS_ARGS)lis_malloc(sizeof(struct LIS_ARGS_STRUCT),"lis_text2args::arg_top");
arg_top->next = arg_top;
arg_top->prev = arg_top;
arg_top->arg1 = NULL;
arg_top->arg2 = NULL;
strcpy(buf,text);
p = buf;
f = LIS_TRUE;
while( *p!='\0' && f )
{
while( *p==' ' || *p=='\t' || *p=='\n' || *p=='\r' )
{
p++;
}
s1 = p;
while( *p!=' ' && *p!='\t' && *p!='\n' && *p!='\r' && *p!='\0' )
{
*p = (char)tolower(*p);
p++;
}
if( *p=='\0' ) break;
*p++ = '\0';
while( *p==' ' && *p=='\t' && *p=='\n' && *p=='\r' )
{
p++;
}
s2 = p;
while( *p!=' ' && *p!='\t' && *p!='\n' && *p!='\r' && *p!='\0' )
{
*p = (char)tolower(*p);
p++;
}
if( *p=='\0' ) f = LIS_FALSE;
*p++ = '\0';
k1 = (LIS_INT)strlen(s1);
k2 = (LIS_INT)strlen(s2);
if( k1>0 && k2>0 )
{
arg = (LIS_ARGS)lis_malloc(sizeof(struct LIS_ARGS_STRUCT),"lis_text2args::arg");
arg->arg1 = (char *)lis_malloc((k1+1)*sizeof(char),"lis_text2args::arg->arg1");
arg->arg2 = (char *)lis_malloc((k2+1)*sizeof(char),"lis_text2args::arg->arg2");
arg->next = arg_top;
arg->prev = arg_top->prev;
arg->prev->next = arg;
arg->next->prev = arg;
strcpy(arg->arg1,s1);
strcpy(arg->arg2,s2);
}
}
*args = arg_top;
LIS_DEBUG_FUNC_OUT;
return LIS_SUCCESS;
}
