U0 LogScrambleFile(U8 *name)
{
CDoc *doc=DocRead(name,DOCF_PLAIN_TEXT);
CDocEntry *doc_e=doc->root.next;
I64 i;
U32 num;
U8 *st,*st2;
"Scrambling: %s\n",name;
while (doc_e!=doc) {
if (doc_e->type_u8==DOCT_TEXT) {
st=MAlloc(StrLen(doc_e->tag)+1);
st2=MAlloc(StrLen(doc_e->tag)+1);
StrFirstRem(doc_e->tag," ",st);
for (i=3;i>=0;i--) {
StrFirstRem(st,".",st2);
num.u8[i]=key[i][A2I(st2)&255];
}
Free(st);
Free(st2);
st=MSPrintF("%d.%d.%d.%d %s",num.u8[3],num.u8[2],num.u8[1],num.u8[0],doc_e->tag);
Free(doc_e->tag);
doc_e->tag=st;
}
doc_e=doc_e->next;
}
DocWrite(doc);
DocDel(doc);
}
U8 *FileNameAbs(U8 *_filename,I64 fuf_flags=0)
{ //$LK,"FUF_Z_OR_NOT_Z","MN:FUF_Z_OR_NOT_Z"$, $LK,"FUF_SCAN_PARENTS","MN:FUF_SCAN_PARENTS"$
U8 *buf,*buf2,*buf3,*filename,*temp_name,*temp_buf;
CDirEntry de;
filename=MStrUtil(_filename,
SUF_REM_LEADING|SUF_REM_TRAILING|SUF_REM_CTRL_CHARS);
temp_name=filename;
buf=StrNew(filename);
temp_buf=buf;
if (*buf && buf[1]==':') {
buf+=2;
filename+=2;
}
buf2=MAlloc(StrLen(temp_name)+1);
StrLastRem(buf,"/",buf2);
if (*filename=='/' && !*buf)
StrCpy(buf,"/");
buf3=DirNameAbs(temp_buf);
Free(temp_buf);
buf=MAlloc(StrLen(buf3)+1+StrLen(buf2)+1);
StrCpy(buf,buf3);
if (buf[StrLen(buf)-1]!='/')
StrCat(buf,"/");
StrCat(buf,buf2);
Free(buf2);
Free(buf3);
Free(temp_name);
if (fuf_flags&&FileFind(buf,&de,fuf_flags|FUF_JUST_FILES)) {
Free(buf);
buf=de.full_name;
}
return buf;
}
CFifoI64 *FifoI64New(I64 size,CTask *mem_task=NULL)
{
CFifoI64 *f;
if (!mem_task) mem_task=Fs;
f=MAlloc(sizeof(CFifoI64),mem_task);
f->buf=MAlloc(size*sizeof(I64),mem_task);
f->mask=size-1;
f->in_ptr=0;
f->out_ptr=0;
return f;
}
CFileAccess *FileAccessNew(U8 *_mask,Bool make_mask=FALSE,Bool make_dirs=FALSE)
{
Bool valid=TRUE,old_silent;
U8 *buf,*mask,*temp_mask;
CFileAccess *fa=CAlloc(sizeof(CFileAccess));
mask=MStrUtil(_mask,
SUF_REM_LEADING|SUF_REM_TRAILING|SUF_REM_CTRL_CHARS);
temp_mask=mask;
fa->old_dir=StrNew(Fs->cur_dir);
fa->old_prt=Fs->cur_prt;
if (*mask && mask[1]==':') {
if (Fs->cur_prt!=Drv2Prt(*mask))
if (!Drv(*mask)) valid=FALSE;
mask+=2;
}
if (StrStr(mask,"HOME") && Fs->cur_prt!=Drv2Prt(*sys_acct))
Drv(*sys_acct);
fa->p=Fs->cur_prt;
PrtChk(fa->p);
buf=MAlloc(StrLen(mask)+2);
StrCpy(buf,mask);
fa->mask=MAlloc(StrLen(mask)+2);
StrLastRem(buf,"/",fa->mask);
if (*mask=='/' && !*buf)
StrCpy(buf,"/");
//If began with Dir, change to Dir.
if (*buf && !Cd(buf,make_dirs))
valid=FALSE;
if (valid && make_mask) {
if (!*fa->mask) {
Free(fa->mask);
fa->mask=StrNew("*");
} else {
if (!make_dirs || FileNameChk(fa->mask)) {
old_silent=Silent(ON);
//Try mask to see if Dir. If Dir, change to dir and set to "*".
if (Cd(fa->mask,make_dirs)) {
Free(fa->mask);
fa->mask=StrNew("*");
}
Silent(old_silent);
}
}
}
Free(buf);
Free(temp_mask);
if (!valid) {
FileAccessDel(fa);
fa=NULL;
// throw(EXCEPT_FILE);
}
return fa;
}
U0 QueVectU8Put(CQueVectU8 *v,I64 index,U8 ch)
{
CQueVectU8 *tempv;
index-=v->min_index;
if (index<0) return;
if (index<v->total_cnt) {
tempv=v;
do {
index-=tempv->node_cnt;
if (index<0) {
tempv->body[index+tempv->node_cnt]=ch;
return;
}
tempv=tempv->next;
} while (tempv!=v);
} else
index-=v->total_cnt;
while (TRUE) {
tempv=v->last;
if (tempv->node_cnt>=QUE_VECT_U8_CNT) {
tempv=MAlloc(sizeof(CQueVectU8));
tempv->node_cnt=0;
QueIns(tempv,v->last);
}
if (index--) {
tempv->body[tempv->node_cnt++]=0;
v->total_cnt++;
} else {
tempv->body[tempv->node_cnt++]=ch;
v->total_cnt++;
break;
}
}
}
CTaskStk *TaskStkNew(I64 stk_size,CTask *task)
{
CTaskStk *temps=MAlloc(stk_size+offset(CTaskStk.stk_base),task);
temps->next_stk=NULL;
temps->stk_ptr=NULL;
temps->stk_size=MSize(temps)-offset(CTaskStk.stk_base);
return temps;
}
CQueVectU8 *QueVectU8New(I64 min_index=0)
{
CQueVectU8 *result=MAlloc(sizeof(CQueVectU8));
result->next=result->last=result;
result->total_cnt=result->node_cnt=0;
result->min_index=min_index;
return result;
}
public Bool DocTreeFind(CDoc *doc,U8 *path,
CDocEntry **_tree_entry=NULL,
CDocEntry **_start_indent=NULL, CDocEntry **_end_indent=NULL)
{
I64 i=0,k=0;
U8 *st1=StrNew(path),*st2=MAlloc(StrLen(path)+1);
Bool result=FALSE,unlock_doc=DocLock(doc);
CDocEntry *doc_e=doc->root.next;
if (_tree_entry) *_tree_entry=doc;
if (_start_indent) *_start_indent=doc;
if (_end_indent) *_end_indent=doc;
while (*st1 && doc_e!=doc) {
StrFirstRem(st1,"/",st2);
if (*st2) {
while (doc_e!=doc) {
if (doc_e->type_u8==DOCT_INDENT)
i+=doc_e->attr;
else if (i==k && doc_e->flags1&DOCEF1_TREE && !StrCmp(doc_e->tag+3,st2)) {
if (*st1)
break;
else {
if (_tree_entry) *_tree_entry=doc_e;
i=0;
while (doc_e!=doc && doc_e->type_u8!=DOCT_INDENT)
doc_e=doc_e->next;
if (doc_e!=doc) {
i=doc_e->attr;
if (_start_indent) *_start_indent=doc_e;
doc_e=doc_e->next;
while (doc_e!=doc && i>0) {
if (doc_e->type_u8==DOCT_INDENT) {
i+=doc_e->attr;
if (i<=0) {
if (_end_indent) *_end_indent=doc_e;
result=TRUE;
break;
}
}
doc_e=doc_e->next;
}
}
goto ft_done;
}
}
doc_e=doc_e->next;
}
k+=2;
}
}
ft_done:
if (unlock_doc)
DocUnlock(doc);
Free(st1);
Free(st2);
return result;
}
U8 *ChgExt(U8 *filename,U8 *extension)
{ //Change file name extension
U8 *result=MAlloc(StrLen(filename)+1+StrLen(extension)+1);
StrCpy(result,filename);
if (FileExtDot(filename))
FileExtRem(result);
StrCat(result,".");
StrCat(result,extension);
return result;
}
U8 *DftExt(U8 *filename,U8 *extension)
{ //Give extension if has none.
U8 *result=MAlloc(StrLen(filename)+1+StrLen(extension)+1);
StrCpy(result,filename);
if (!FileExtDot(filename)) {
StrCat(result,".");
StrCat(result,extension);
}
return result;
}
U8 *CurDir(CTask *task=NULL,CTask *mem_task=NULL)
{
U8 *st;
if (!task) task=Fs;
if (!task->cur_dir)
return NULL;
st=MAlloc(StrLen(task->cur_dir)+3,mem_task);
*st=Prt2Drv;
st[1]=':';
StrCpy(st+2,task->cur_dir);
return st;
}
char *String0::Alloc(int count, char& kind)
{
if(count < 32) {
kind = MEDIUM;
return (char *)MAlloc_S();
}
size_t sz = sizeof(Rc) + count + 1;
Rc *rc = (Rc *)MAlloc(sz);
rc->alloc = sz - sizeof(Rc) - 1;
rc->refcount = 1;
kind = min(rc->alloc, 255);
return (char *)(rc + 1);
}
void test_calls_wptr (Workspace p, int i)
{
void *ptr;
Reschedule (p);
if (i == 0) {
SetErr (p);
SetErrM (p, "test");
Shutdown (p);
}
ptr = MAlloc (p, i);
MRelease (p, ptr);
}
char *StringBuffer::Alloc(int count, int& alloc)
{
if(count <= 31) {
char *s = (char *)MAlloc_S();
alloc = 31;
return s;
}
else {
size_t sz = sizeof(Rc) + count + 1;
Rc *rc = (Rc *)MAlloc(sz);
alloc = rc->alloc = sz - sizeof(Rc) - 1;
rc->refcount = 1;
return (char *)(rc + 1);
}
}
static void AddToList( const char *name, ctl_file **owner )
{
ctl_file *curr;
for( ;; ) {
curr = *owner;
if( curr == NULL )
break;
owner = &curr->next;
}
curr = MAlloc( sizeof( *curr ) );
curr->next = NULL;
strcpy( curr->name, name );
*owner = curr;
}
public U8 *DBlk(I64 blk,Bool write=FALSE)
{//Dump Disk Blk.
//If you set write to TRUE, it will be written when you press <ESC>.
//See $LK-A,"::/TempleOS/Demo/Dsk/Raw.CPP"$.
U8 *buf=MAlloc(BLK_SIZE);
RBlks(Fs->cur_prt,buf,blk,1);
DocD(buf,BLK_SIZE);
if (write) {
"Edit and press <ESC> to write or <SHIFT-ESC>\n";
if (View) {
"Write\n";
WBlks(Fs->cur_prt,buf,blk,1);
}
}
return buf;
}
Bool FilesFindMatch(U8 *files_find_mask,U8 *filename,I64 fuf_flags=0)
{
U8 *st1=StrNew(files_find_mask),
*st2=MAlloc(StrLen(files_find_mask)+1);
Bool result=FALSE;
while (TRUE) {
StrFirstRem(st1,";",st2);
if (*st2) {
if (*st2=='~') {
if (WildCardMatch(st2+1,filename)) {
result=FALSE;
break;
}
} else {
if (WildCardMatch(st2,filename)) {
if (Bt(&fuf_flags,FUf_JUST_TXT_FILES) && !FilesFindMatch(FILENAME_MASK_TXT,filename)) {
result=FALSE;
break;
} else if (Bt(&fuf_flags,FUf_JUST_SRC_FILES) && !FilesFindMatch(FILENAME_MASK_SRC,filename)) {
result=FALSE;
break;
} else if (Bt(&fuf_flags,FUf_JUST_AOT_FILES) && !FilesFindMatch(FILENAME_MASK_AOT,filename)) {
result=FALSE;
break;
} else if (Bt(&fuf_flags,FUf_JUST_JIT_FILES) && !FilesFindMatch(FILENAME_MASK_JIT,filename)) {
result=FALSE;
break;
} else if (Bt(&fuf_flags,FUf_JUST_GRA_FILES) && !FilesFindMatch(FILENAME_MASK_GRA,filename)) {
result=FALSE;
break;
} else
result=TRUE;
}
}
} else
break;
}
Free(st1);
Free(st2);
return result;
}
U0 EdRACollect(CDoc *doc,CRenum *root)
{
I64 ch,i;
CRenum *tempr;
U8 buf[sizeof(CEdFindText.find_text)];
ch=EdRAGetU8(doc);
while (ch>=0) {
if (ch!='@')
ch=EdRAGetU8(doc);
else {
ch=EdRAGetU8(doc);
if (ch=='@') {
ch=EdRAGetU8(doc);
StrCpy(buf,"@@");
i=2;
while (ch>=0 && i<sizeof(CEdFindText.find_text)) {
if (Bt(alpha_numeric_bitmap,ch))
buf[i++]=ch;
else
break;
ch=EdRAGetU8(doc);
}
if (i<sizeof(CEdFindText.find_text)) {
buf[i++]=0;
while (ch>=0 && Bt(white_space_bitmap,ch))
ch=EdRAGetU8(doc);
if (ch==':') {
ch=EdRAGetU8(doc);
tempr=MAlloc(sizeof(CRenum));
StrCpy(tempr->label,buf);
QueIns(tempr,root->last);
}
}
}
}
}
//This is needed because we moved the
//cursor and it didn't recalc.
DocRecalc(doc);
}
CArcCtrl *ArcCtrlNew(Bool expand,Bool text_only)
{
CArcCtrl *c;
c=CAlloc(sizeof(CArcCtrl));
if (expand) {
c->stk_base=MAlloc(ARC_MAX_ENTRY+1);
c->stk_ptr=c->stk_base;
}
if (text_only)
c->min_bits=7;
else
c->min_bits=8;
c->min_table_entry=1<<c->min_bits;
c->free_index=c->min_table_entry;
c->next_bits_in_use=c->min_bits+1;
c->free_limit=1<<c->next_bits_in_use;
c->saved_basecode=MAX_U32;
c->entry_used=TRUE;
ArcGetEntry(c);
c->entry_used=TRUE;
return c;
}
CArcCompress *CompressBuf(U8 *src,I64 size,
I64 flags=0,CTask *mem_task=NULL)
{
CArcCompress *result;
I64 size_out;
Bool text_only=ArcDetermineCompressionType(src,size)==CT_7_BIT;
CArcCtrl *c=ArcCtrlNew(FALSE,text_only);
c->src_size=size;
c->src_buf=src;
c->dst_size=(size+sizeof(CArcCompress))<<3;
c->dst_buf=CAlloc(c->dst_size>>3);
c->dst_pos=sizeof(CArcCompress)<<3;
ArcCompressBuf(c);
ArcFinishCompression(c);
if (c->src_pos==c->src_size) {
size_out=(c->dst_pos+7)>>3;
result=MAlloc(size_out,mem_task);
MemCpy(result,c->dst_buf,size_out);
if (text_only)
result->compression_type=CT_7_BIT;
else
result->compression_type=CT_8_BIT;
result->compressed_size=size_out;
} else {
void* REalloc(void* block, long bytes, char* datei, int zeile)
#endif
{
static void* address;
#ifdef MEMORY_REALLOC
static char* a;
static char* b;
#endif
#ifdef MEMORY_TEST_IN_TIME
/* Es wird in den folgenden verschiedenen "#ifdef"-Abschnitten
sehr wuest mit den Eingangsgroessen hantiert, darum lege ich sie
erstmal ab ... */
long old_block;
long new_bytes;
long i;
old_block = (long) block;
new_bytes = (long) bytes;
#endif
#ifdef MEMORY_MANAGEMENT_NOT_ANSI_COMPLIANT
/* Laut ANSI nicht noetig, zur Sicherheit eingefuegt. CT */
if (block == NULL)
#ifndef MEMORY_STR
return Malloc(bytes);
#else
return MAlloc(bytes, datei, zeile);
#endif
if (bytes == 0)
#ifndef MEMORY_STR
return Free(block);
#else
return FRee(block, datei, zeile);
#endif
#endif
#ifdef MEMORY_REALLOC
#ifndef MEMORY_STR
address = Malloc(bytes);
#else
address = MAlloc(bytes, datei, zeile);
#endif
if (!(block == NULL))
{
a = (char*) address;
b = (char*) block;
{
/* beim Vergroessern wird ein laengerer Bereich gelesen,
als eigentlich belegt war !
--> nur mit eigener Speichertabelle zu aendern */
register long i;
i = 0l;
while (i < bytes)
{
a[i] = b[i];
i++;
}
}
}
#ifndef MEMORY_STR
block = Free(block);
#else
block = FRee(block, datei, zeile); /* vorher Free msr 0796 */
#endif
#else // ifdef MEMORY_REALLOC
address = (void*) realloc(block, (size_t) bytes);
#ifdef MEMORY_SHOW_USAGE
printf("address %8x %ld , ",address,(long)address);
#endif
#endif
#ifdef MEMORY_ALLOCATION_TEST_SUCCESS
if ((bytes) && (address == 0)) /* Angeforderter Speicher wurde nicht geliefert */
{
#ifdef MEMORY_STR
printf("Malloc aufgerufen von %s Zeile %d. \n", datei, zeile);
#endif
printf("Malloc ist fehlgeschlagen!!!\n");
}
#endif
#ifdef MEMORY_TEST_IN_TIME
if (memtab)
{
/* Nach "Block" in der Speichertabelle suchen */
i = memory_list_size - 1;
/* Von hinten anfangen muesste schneller gehen, da sich die "alten"
Addressen (hoffentlich) am Anfang sammeln. */
while (i >= 0)
{
if (memtab[i].address == old_block)
{
/* Richtiger Block wurde gefunden! Kann freigegeben werden. */
memory_alloced = memory_alloced - memtab[i].size + new_bytes;
memtab[i].address = (long) address;
memtab[i].size = (long) new_bytes;
#ifdef MEMORY_STR
memtab[i].file = datei;
memtab[i].line = zeile;
#endif
i = 0;
}
i = i - 1;
}
#ifdef MEMORY_SHOW_USAGE
#ifdef MEMORY_STR
printf("Realloc aufgerufen von %s Zeile %d. ", datei, zeile);
#endif
printf("Bytes im Speicher: %ld \n", memory_alloced);
#endif
if (memory_alloced > memory_max_alloced)
memory_max_alloced = memory_alloced;
}
#endif
return address;
}
void mexFunction
(
/* === Parameters ======================================================= */
int nlhs, /* number of left-hand sides */
mxArray *plhs [], /* left-hand side matrices */
int nrhs, /* number of right--hand sides */
const mxArray *prhs [] /* right-hand side matrices */
)
{
Zmat A;
ZAMGlevelmat *PRE;
ZILUPACKparam *param;
integer n;
const char **fnames;
const mwSize *dims;
mxClassID *classIDflags;
mxArray *tmp, *fout, *A_input , *b_input, *x0_input, *options_input,
*PRE_input, *options_output, *x_output;
char *pdata, *input_buf, *output_buf;
mwSize mrows, ncols, buflen, ndim,nnz;
int ifield, status, nfields, ierr,i,j,k,l,m;
size_t sizebuf;
double dbuf, *A_valuesR, *A_valuesI, *convert, *sr, *pr, *pi;
doublecomplex *sol, *rhs;
mwIndex *irs, *jcs,
*A_ja, /* row indices of input matrix A */
*A_ia; /* column pointers of input matrix A */
if (nrhs != 5)
mexErrMsgTxt("five input arguments required.");
else if (nlhs !=2)
mexErrMsgTxt("Too many output arguments.");
else if (!mxIsStruct(prhs[2]))
mexErrMsgTxt("Third input must be a structure.");
else if (!mxIsNumeric(prhs[0]))
mexErrMsgTxt("First input must be a matrix.");
/* The first input must be a square matrix.*/
A_input = (mxArray *) prhs [0] ;
/* get size of input matrix A */
mrows = mxGetM (A_input) ;
ncols = mxGetN (A_input) ;
nnz = mxGetNzmax(A_input);
if (mrows!=ncols) {
mexErrMsgTxt("First input must be a square matrix.");
}
if (!mxIsSparse (A_input))
{
mexErrMsgTxt ("ILUPACK: input matrix must be in sparse format.") ;
}
/* copy input matrix to sparse row format */
A.nc=A.nr=mrows;
A.ia=(integer *) MAlloc((size_t)(A.nc+1)*sizeof(integer),"ZGNLSYMilupacksolver");
A.ja=(integer *) MAlloc((size_t)nnz *sizeof(integer),"ZGNLSYMilupacksolver");
A. a=(doublecomplex *) MAlloc((size_t)nnz *sizeof(doublecomplex), "ZGNLSYMilupacksolver");
A_ja = (mwIndex *) mxGetIr (A_input) ;
A_ia = (mwIndex *) mxGetJc (A_input) ;
A_valuesR = (double *) mxGetPr(A_input);
if (mxIsComplex(A_input))
A_valuesI = (double *) mxGetPi(A_input);
/* -------------------------------------------------------------------- */
/* .. Convert matrix from 0-based C-notation to Fortran 1-based */
/* notation. */
/* -------------------------------------------------------------------- */
/*
for (i = 0 ; i < ncols ; i++)
for (j = A_ia[i] ; j < A_ia[i+1] ; j++)
printf("i=%d j=%d A.real=%e\n", i+1, A_ja[j]+1, A_valuesR[j]);
*/
for (i=0; i<=A.nr; i++)
A.ia[i]=0;
/* remember that MATLAB uses storage by columns and NOT by rows! */
for (i=0; i<A.nr; i++) {
for (j=A_ia[i]; j<A_ia[i+1]; j++) {
k=A_ja[j];
A.ia[k+1]++;
}
}
/* now we know how many entries are located in every row */
/* switch to pointer structure */
for (i=0; i<A.nr; i++)
A.ia[i+1]+=A.ia[i];
if (mxIsComplex(A_input)) {
for (i=0; i<ncols; i++) {
for (j=A_ia[i]; j<A_ia[i+1]; j++) {
/* row index l in C-notation */
l=A_ja[j];
/* where does row l currently start */
k=A.ia[l];
/* column index will be i in FORTRAN notation */
A.ja[k]=i+1;
A.a [k].r =A_valuesR[j];
A.a [k++].i=A_valuesI[j];
A.ia[l]=k;
}
}
}
else {
for (i=0; i<ncols; i++) {
for (j=A_ia[i]; j<A_ia[i+1]; j++) {
/* row index l in C-notation */
l=A_ja[j];
/* where does row l currently start */
k=A.ia[l];
/* column index will be i in FORTRAN notation */
A.ja[k]=i+1;
A.a [k].r =A_valuesR[j];
A.a [k++].i=0;
A.ia[l]=k;
}
}
}
/* switch to FORTRAN style */
for (i=A.nr; i>0; i--)
A.ia[i]=A.ia[i-1]+1;
A.ia[0]=1;
/*
for (i = 0 ; i < A.nr ; i++)
for (j = A.ia[i]-1 ; j < A.ia[i+1]-1 ; j++)
printf("i=%d j=%d A.real=%e A.imag=%e\n", i+1, A.ja[j], A.a[j].r, A.a[j].i);
*/
/* import pointer to the preconditioner */
PRE_input = (mxArray*) prhs [1] ;
/* get number of levels of input preconditioner structure `PREC' */
/* nlev=mxGetN(PRE_input); */
nfields = mxGetNumberOfFields(PRE_input);
/* allocate memory for storing pointers */
fnames = mxCalloc((size_t)nfields, (size_t)sizeof(*fnames));
for (ifield = 0; ifield < nfields; ifield++) {
fnames[ifield] = mxGetFieldNameByNumber(PRE_input,ifield);
/* check whether `PREC.ptr' exists */
if (!strcmp("ptr",fnames[ifield])) {
/* field `ptr' */
tmp = mxGetFieldByNumber(PRE_input,0,ifield);
pdata = mxGetData(tmp);
memcpy(&PRE, pdata, (size_t)sizeof(size_t));
}
else if (!strcmp("param",fnames[ifield])) {
/* field `param' */
tmp = mxGetFieldByNumber(PRE_input,0,ifield);
pdata = mxGetData(tmp);
memcpy(¶m, pdata, (size_t)sizeof(size_t));
}
}
mxFree(fnames);
/* rescale input matrix */
/* obsolete
for (i=0; i <A.nr; i++) {
for (j=A.ia[i]-1; j<A.ia[i+1]-1; j++) {
A.a[j].r*=PRE->rowscal[i].r*PRE->colscal[A.ja[j]-1].r;
A.a[j].i*=PRE->rowscal[i].r*PRE->colscal[A.ja[j]-1].r;
}
}
*/
/* Get third input argument `options' */
options_input=(mxArray*)prhs[2];
nfields = mxGetNumberOfFields(options_input);
/* Allocate memory for storing classIDflags */
classIDflags = (mxClassID *) mxCalloc((size_t)nfields+1, (size_t)sizeof(mxClassID));
/* allocate memory for storing pointers */
fnames = mxCalloc((size_t)nfields+1, (size_t)sizeof(*fnames));
/* Get field name pointers */
j=-1;
for (ifield = 0; ifield < nfields; ifield++) {
fnames[ifield] = mxGetFieldNameByNumber(options_input,ifield);
/* check whether `options.niter' already exists */
if (!strcmp("niter",fnames[ifield]))
j=ifield;
}
if (j==-1)
fnames[nfields]="niter";
/* mexPrintf("search for niter completed\n"); fflush(stdout); */
/* import data */
for (ifield = 0; ifield < nfields; ifield++) {
/* mexPrintf("%2d\n",ifield+1); fflush(stdout); */
tmp = mxGetFieldByNumber(options_input,0,ifield);
classIDflags[ifield] = mxGetClassID(tmp);
ndim = mxGetNumberOfDimensions(tmp);
dims = mxGetDimensions(tmp);
/* Create string/numeric array */
if (classIDflags[ifield] == mxCHAR_CLASS) {
/* Get the length of the input string. */
buflen = (mxGetM(tmp) * mxGetN(tmp)) + 1;
/* Allocate memory for input and output strings. */
input_buf = (char *) mxCalloc((size_t)buflen, (size_t)sizeof(char));
/* Copy the string data from tmp into a C string
input_buf. */
status = mxGetString(tmp, input_buf, buflen);
if (!strcmp("amg",fnames[ifield])) {
if (strcmp(param->amg,input_buf)) {
param->amg=(char *)MAlloc((size_t)buflen*sizeof(char),"ilupacksolver");
strcpy(param->amg,input_buf);
}
}
else if (!strcmp("presmoother",fnames[ifield])) {
if (strcmp(param->presmoother,input_buf)) {
param->presmoother=(char *)MAlloc((size_t)buflen*sizeof(char),
"ilupacksolver");
strcpy(param->presmoother,input_buf);
}
}
else if (!strcmp("postsmoother",fnames[ifield])) {
if (strcmp(param->postsmoother,input_buf)) {
param->postsmoother=(char *)MAlloc((size_t)buflen*sizeof(char),
"ilupacksolver");
strcpy(param->postsmoother,input_buf);
}
}
else if (!strcmp("typecoarse",fnames[ifield])) {
if (strcmp(param->typecoarse,input_buf)) {
param->typecoarse=(char *)MAlloc((size_t)buflen*sizeof(char),
"ilupacksolver");
strcpy(param->typecoarse,input_buf);
}
}
else if (!strcmp("typetv",fnames[ifield])) {
if (strcmp(param->typetv,input_buf)) {
param->typetv=(char *)MAlloc((size_t)buflen*sizeof(char),
"ilupacksolver");
strcpy(param->typetv,input_buf);
}
}
else if (!strcmp("FCpart",fnames[ifield])) {
if (strcmp(param->FCpart,input_buf)) {
param->FCpart=(char *)MAlloc((size_t)buflen*sizeof(char),
"ilupacksolver");
strcpy(param->FCpart,input_buf);
}
}
else if (!strcmp("solver",fnames[ifield])) {
if (strcmp(param->solver,input_buf)) {
param->solver=(char *)MAlloc((size_t)buflen*sizeof(char),
"ilupacksolver");
strcpy(param->solver,input_buf);
}
}
else if (!strcmp("ordering",fnames[ifield])) {
if (strcmp(param->ordering,input_buf)) {
param->ordering=(char *)MAlloc((size_t)buflen*sizeof(char),
"ilupacksolver");
strcpy(param->ordering,input_buf);
}
}
else {
/* mexPrintf("%s ignored\n",fnames[ifield]);fflush(stdout); */
}
}
else {
if (!strcmp("elbow",fnames[ifield])) {
param->elbow=*mxGetPr(tmp);
}
else if (!strcmp("lfilS",fnames[ifield])) {
param->lfilS=*mxGetPr(tmp);
}
else if (!strcmp("lfil",fnames[ifield])) {
param->lfil=*mxGetPr(tmp);
}
else if (!strcmp("maxit",fnames[ifield])) {
param->maxit=*mxGetPr(tmp);
}
else if (!strcmp("droptolS",fnames[ifield])) {
param->droptolS=*mxGetPr(tmp);
}
else if (!strcmp("droptolc",fnames[ifield])) {
param->droptolc=*mxGetPr(tmp);
}
else if (!strcmp("droptol",fnames[ifield])) {
param->droptol=*mxGetPr(tmp);
}
else if (!strcmp("condest",fnames[ifield])) {
param->condest=*mxGetPr(tmp);
}
else if (!strcmp("restol",fnames[ifield])) {
param->restol=*mxGetPr(tmp);
}
else if (!strcmp("npresmoothing",fnames[ifield])) {
param->npresmoothing=*mxGetPr(tmp);
}
else if (!strcmp("npostmoothing",fnames[ifield])) {
param->npostsmoothing=*mxGetPr(tmp);
}
else if (!strcmp("ncoarse",fnames[ifield])) {
param->ncoarse=*mxGetPr(tmp);
}
else if (!strcmp("matching",fnames[ifield])) {
param->matching=*mxGetPr(tmp);
}
else if (!strcmp("nrestart",fnames[ifield])) {
param->nrestart=*mxGetPr(tmp);
}
else if (!strcmp("damping",fnames[ifield])) {
param->damping.r=*mxGetPr(tmp);
if (mxIsComplex(tmp))
param->damping.i=*mxGetPi(tmp);
else
param->damping.i=0;
}
else if (!strcmp("mixedprecision",fnames[ifield])) {
param->mixedprecision=*mxGetPr(tmp);
}
else {
/* mexPrintf("%s ignored\n",fnames[ifield]);fflush(stdout); */
}
}
}
/* copy right hand side `b' */
b_input = (mxArray *) prhs [3] ;
/* get size of input matrix A */
rhs=(doublecomplex*) MAlloc((size_t)A.nr*sizeof(doublecomplex),"ZGNLSYMilupacksolver:rhs");
pr=mxGetPr(b_input);
if (!mxIsComplex(b_input)) {
for (i=0; i<A.nr; i++) {
rhs[i].r=pr[i];
rhs[i].i=0;
}
}
else {
pi=mxGetPi(b_input);
for (i=0; i<A.nr; i++) {
rhs[i].r=pr[i];
rhs[i].i=pi[i];
}
}
/* copy initial solution `x0' */
x0_input = (mxArray *) prhs [4] ;
/* numerical solution */
sol=(doublecomplex *)MAlloc((size_t)A.nr*sizeof(doublecomplex),"ZGNLSYMilupacksolver:sol");
pr=mxGetPr(x0_input);
if (!mxIsComplex(x0_input)) {
for (i=0; i<A.nr; i++) {
sol[i].r=pr[i];
sol[i].i=0;
}
}
else {
pi=mxGetPi(x0_input);
for (i=0; i<A.nr; i++) {
sol[i].r=pr[i];
sol[i].i=pi[i];
}
}
/* set bit 2, transpose */
param->ipar[4]|=4;
/* set bit 3, conjugate */
param->ipar[4]|=8;
ierr=ZGNLSYMAMGsolver(&A, PRE, param, rhs, sol);
/* Create a struct matrices for output */
nlhs=2;
if (j==-1)
plhs[1] = mxCreateStructMatrix((mwSize)1, (mwSize)1, (mwSize)nfields+1, fnames);
else
plhs[1] = mxCreateStructMatrix((mwSize)1, (mwSize)1, (mwSize)nfields, fnames);
if (plhs[1]==NULL)
mexErrMsgTxt("Could not create structure mxArray\n");
options_output=plhs[1];
/* export data */
for (ifield = 0; ifield<nfields; ifield++) {
tmp = mxGetFieldByNumber(options_input,0,ifield);
classIDflags[ifield] = mxGetClassID(tmp);
ndim = mxGetNumberOfDimensions(tmp);
dims = mxGetDimensions(tmp);
/* Create string/numeric array */
if (classIDflags[ifield] == mxCHAR_CLASS) {
if (!strcmp("amg",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->amg)+1, (size_t)sizeof(char));
strcpy(output_buf,param->amg);
fout = mxCreateString(output_buf);
}
else if (!strcmp("presmoother",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->presmoother)+1, (size_t)sizeof(char));
strcpy(output_buf,param->presmoother);
fout = mxCreateString(output_buf);
}
else if (!strcmp("postsmoother",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->postsmoother)+1, (size_t)sizeof(char));
strcpy(output_buf,param->postsmoother);
fout = mxCreateString(output_buf);
}
else if (!strcmp("typecoarse",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->typecoarse)+1, (size_t)sizeof(char));
strcpy(output_buf,param->typecoarse);
fout = mxCreateString(output_buf);
}
else if (!strcmp("typetv",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->typetv)+1, (size_t)sizeof(char));
strcpy(output_buf,param->typetv);
fout = mxCreateString(output_buf);
}
else if (!strcmp("FCpart",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->FCpart)+1, (size_t)sizeof(char));
strcpy(output_buf,param->FCpart);
fout = mxCreateString(output_buf);
}
else if (!strcmp("solver",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->solver)+1, (size_t)sizeof(char));
strcpy(output_buf, param->solver);
fout = mxCreateString(output_buf);
}
else if (!strcmp("ordering",fnames[ifield])) {
output_buf = (char *) mxCalloc((size_t)strlen(param->ordering)+1, (size_t)sizeof(char));
strcpy(output_buf, param->ordering);
fout = mxCreateString(output_buf);
}
else {
/* Get the length of the input string. */
buflen = (mxGetM(tmp) * mxGetN(tmp)) + 1;
/* Allocate memory for input and output strings. */
input_buf = (char *) mxCalloc((size_t)buflen, (size_t)sizeof(char));
output_buf = (char *) mxCalloc((size_t)buflen, (size_t)sizeof(char));
/* Copy the string data from tmp into a C string
input_buf. */
status = mxGetString(tmp, input_buf, buflen);
sizebuf = (size_t)buflen*sizeof(char);
memcpy(output_buf, input_buf, sizebuf);
fout = mxCreateString(output_buf);
}
}
else {
/* real case */
if (mxGetPi(tmp)==NULL && strcmp("damping",fnames[ifield]))
fout = mxCreateNumericArray(ndim, dims,
classIDflags[ifield], mxREAL);
else { /* complex case */
fout = mxCreateNumericArray(ndim, dims,
classIDflags[ifield], mxCOMPLEX);
}
pdata = mxGetData(fout);
sizebuf = mxGetElementSize(tmp);
if (!strcmp("elbow",fnames[ifield])) {
dbuf=param->elbow;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("lfilS",fnames[ifield])) {
dbuf=param->lfilS;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("lfil",fnames[ifield])) {
dbuf=param->lfil;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("maxit",fnames[ifield])) {
dbuf=param->maxit;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("droptolS",fnames[ifield])) {
dbuf=param->droptolS;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("droptolc",fnames[ifield])) {
dbuf=param->droptolc;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("droptol",fnames[ifield])) {
dbuf=param->droptol;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("condest",fnames[ifield])) {
dbuf=param->condest;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("restol",fnames[ifield])) {
dbuf=param->restol;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("npresmoothing",fnames[ifield])) {
dbuf=param->npresmoothing;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("npostmoothing",fnames[ifield])) {
dbuf=param->npostsmoothing;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("ncoarse",fnames[ifield])) {
dbuf=param->ncoarse;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("matching",fnames[ifield])) {
dbuf=param->matching;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("nrestart",fnames[ifield])) {
dbuf=param->nrestart;
memcpy(pdata, &dbuf, sizebuf);
}
else if (!strcmp("damping",fnames[ifield])) {
pr=mxGetPr(fout);
pi=mxGetPi(fout);
*pr=param->damping.r;
*pi=param->damping.i;
}
else if (!strcmp("mixedprecision",fnames[ifield])) {
dbuf=param->mixedprecision;
memcpy(pdata, &dbuf, sizebuf);
}
else {
memcpy(pdata, mxGetData(tmp), sizebuf);
}
}
/* Set each field in output structure */
mxSetFieldByNumber(options_output, (mwIndex)0, ifield, fout);
}
/* store number of iteration steps */
if (j==-1)
ifield=nfields;
else
ifield=j;
fout=mxCreateDoubleMatrix((mwSize)1,(mwSize)1, mxREAL);
pr=mxGetPr(fout);
*pr=param->ipar[26];
/* set each field in output structure */
mxSetFieldByNumber(options_output, (mwIndex)0, ifield, fout);
mxFree(fnames);
mxFree(classIDflags);
/* mexPrintf("options exported\n"); fflush(stdout); */
/* export approximate solution */
plhs[0] = mxCreateDoubleMatrix((mwSize)A.nr, (mwSize)1, mxCOMPLEX);
x_output=plhs[0];
pr=mxGetPr(x_output);
pi=mxGetPi(x_output);
for (i=0; i<A.nr; i++) {
pr[i]=sol[i].r;
pi[i]=sol[i].i;
}
/* release right hand side */
free(rhs);
/* release solution */
free(sol);
/* release input matrix */
free(A.ia);
free(A.ja);
free(A.a);
switch (ierr) {
case 0: /* perfect! */
break;
case -1: /* too many iteration steps */
mexPrintf("!!! ILUPACK Warning !!!\n");
mexPrintf("number of iteration steps exceeded its limit.\nEither increase `options.maxit'\n or recompute ILUPACK preconditioner using a smaller `options.droptol'");
break;
case -2: /* weird, should not occur */
mexErrMsgTxt("not enough workspace provided.");
plhs[0]=NULL;
break;
case -3: /* breakdown */
mexErrMsgTxt("iterative solver breaks down.\nMost likely you need to recompute ILUPACK preconditioner using a smaller `options.droptol'");
plhs[0]=NULL;
break;
default: /* zero pivot encountered at step number ierr */
mexPrintf("iterative solver exited with error code %d",ierr);
mexErrMsgTxt(".");
plhs[0]=NULL;
break;
} /* end switch */
return;
}
Bool Cd(U8 *dirname,Bool make_dirs=FALSE)
{//Optionally, will create the directories if they don't exist.
I64 maxlen,cur_dir_cluster=0;
U8 *chg_to_buf,*new_cur_dir,*buf;
CPrt *p;
Bool result=TRUE;
if (!*dirname) return TRUE;
if (dirname[1]==':') {
if (*dirname==':') {
if (Fs->cur_prt->drv_let!=*sys_acct)
if (!Drv(*dirname)) return FALSE;
} else {
if (Fs->cur_prt!=
Drv2Prt(*dirname))
if (!Drv(*dirname)) return FALSE;
}
dirname+=2;
}
if (*dirname=='/' || !*dirname || !Fs->cur_dir) {
Free(Fs->cur_dir);
Fs->cur_dir=StrNew("/");
if (*dirname=='/')
dirname++;
}
chg_to_buf=MStrUtil(dirname,
SUF_REM_LEADING|SUF_REM_TRAILING|SUF_REM_CTRL_CHARS);
maxlen=StrLen(Fs->cur_dir)+1+StrLen(chg_to_buf)+1;
new_cur_dir=MAlloc(maxlen);
buf=MAlloc(maxlen);
StrCpy(new_cur_dir,Fs->cur_dir);
while (*chg_to_buf && result) {
StrFirstRem(chg_to_buf,"/",buf);
if (!*buf)
StrCpy(new_cur_dir,"/");
else if (!StrCmp(buf,"..")) {
StrLastRem(new_cur_dir,"/");
if (!*new_cur_dir)
StrCpy(new_cur_dir,"/");
} else if (!StrCmp(buf,".")) {
;
} else if (*buf) {
if (!StrCmp(buf,"HOME")) {
result=Cd(sys_acct);
Free(new_cur_dir);
new_cur_dir=MAlloc(maxlen+StrLen(sys_acct));
StrCpy(new_cur_dir,sys_acct+2);
} else {
p=Fs->cur_prt;
cur_dir_cluster=Name2DirCluster(p,new_cur_dir);
switch (p->type) {
case PT_REDSEA:
result=RedSeaFSCd(buf,cur_dir_cluster);
break;
case PT_FAT32:
result=FAT32Cd(buf,cur_dir_cluster);
break;
case PT_ISO9660:
result=ISO1Cd(buf,cur_dir_cluster);
break;
default:
PutDefineErr("ST_UNSUPPORTED_FILE_SYSTEM");
result=FALSE;
}
if (!result && make_dirs) {
Free(Fs->cur_dir);
Fs->cur_dir=StrNew(new_cur_dir);
result=MkDir(buf);
}
if (result) {
if (StrCmp(new_cur_dir,"/"))
StrCat(new_cur_dir,"/");
StrCat(new_cur_dir,buf);
}
}
}
}
Free(Fs->cur_dir);
Fs->cur_dir=StrNew(new_cur_dir);
Free(buf);
Free(chg_to_buf);
Free(new_cur_dir);
return result;
}
void mexFunction
(
/* === Parameters ======================================================= */
int nlhs, /* number of left-hand sides */
mxArray *plhs[], /* left-hand side matrices */
int nrhs, /* number of right--hand sides */
const mxArray *prhs[] /* right-hand side matrices */
)
{
mxArray *b_input;
integer i, m;
size_t n;
double *pr, *pi;
doublecomplex *rhs, *sol;
static integer ipar[16];
static double fpar[16];
static doublecomplex *workspace;
static int init=0;
if (nrhs != 8)
mexErrMsgTxt("Eight input argument required.");
else if (nlhs!=5)
mexErrMsgTxt("Five output arguments are required.");
else if (!mxIsNumeric(prhs[0]))
mexErrMsgTxt("First input must be a matrix.");
/* First input parameter: right hand side */
b_input = (mxArray *) prhs[0] ;
pr=mxGetPr(b_input);
n=mxGetM(b_input);
rhs=(doublecomplex *) MAlloc((size_t)n*sizeof(doublecomplex), "DSYMilupacksqmr");
if (!mxIsComplex(b_input)) {
for (i=0; i<n; i++) {
rhs[i].r=pr[i];
rhs[i].i=0;
}
}
else {
pi=mxGetPi(b_input);
for (i=0; i<n; i++) {
rhs[i].r=pr[i];
rhs[i].i=pi[i];
}
}
/* Second input parameter: initial guess */
b_input = (mxArray *) prhs[1] ;
pr=mxGetPr(b_input);
sol=(doublecomplex *) MAlloc((size_t)n*sizeof(doublecomplex), "DSYMilupacksqmr");
if (!mxIsComplex(b_input)) {
for (i=0; i<n; i++) {
sol[i].r=pr[i];
sol[i].i=0;
}
}
else {
pi=mxGetPi(b_input);
for (i=0; i<n; i++) {
sol[i].r=pr[i];
sol[i].i=pi[i];
}
}
/* Third input parameter: drain, result from matrix-vector multiplication or preconditioning */
/* we must have called the routine earlier */
if (init) {
b_input = (mxArray *) prhs[2] ;
pr=mxGetPr(b_input);
workspace--;
if (!mxIsComplex(b_input)) {
for (i=0; i<n; i++) {
workspace[ipar[8]+i].r=pr[i];
workspace[ipar[8]+i].i=0;
}
}
else {
pi=mxGetPi(b_input);
for (i=0; i<n; i++) {
workspace[ipar[8]+i].r=pr[i];
workspace[ipar[8]+i].i=pi[i];
}
}
workspace++;
}
/* Fourth input parameter: tol */
b_input = (mxArray *) prhs[3] ;
pr=mxGetPr(b_input);
fpar[0]=*pr;
/* Fifth input parameter: maxit */
b_input = (mxArray *) prhs[4] ;
pr=mxGetPr(b_input);
ipar[5]=*pr;
/* Sixth input parameter: control */
if (init) {
b_input = (mxArray *) prhs[5] ;
pr=mxGetPr(b_input);
if (*pr==1)
ipar[0]=1;
else if (*pr==2)
ipar[0]=5;
}
/* so far use 'right' preconditioning */
ipar[1]=2;
/* size of our workspace */
ipar[3]=6*n;
/* not referenced */
ipar[4]=0;
/* no absolute tolerance */
fpar[1]=0.0;
/* init parameters for sqmr when called for the first time */
if (!init) {
init=1;
/* init solver */
ipar[0]=0;
/* init with zeros */
ipar[6]=ipar[7]=ipar[8]=ipar[9]=ipar[10]=ipar[11]=ipar[12]=ipar[13]=
ipar[14]=ipar[15]=0;
fpar[2]=fpar[3]=fpar[4]=fpar[5]=fpar[6]=fpar[7]=fpar[8]=fpar[9]=fpar[10]=
fpar[11]=fpar[12]=fpar[13]=fpar[14]=fpar[15]=0.0;
/* provide workspace */
workspace=(doublecomplex *) MAlloc(6*(size_t)n*sizeof(doublecomplex),"DSYMilupacksqmr");
}
/* Seventh input parameter: nrmA */
b_input = (mxArray *) prhs[6] ;
pr=mxGetPr(b_input);
fpar[11]=*pr;
/* Eighth input parameter: typeres */
b_input = (mxArray *) prhs[7] ;
pr=mxGetPr(b_input);
/* use backward error as stopping criterion */
ipar[2]=*pr;
m=n;
ZSYMqmr(&m,rhs,sol,ipar,fpar,workspace);
/* Create output vector */
nlhs=5;
/* first left hand side: x */
plhs[0] =mxCreateDoubleMatrix(n,1, mxCOMPLEX);
pr = (double *) mxGetPr(plhs[0]);
pi = (double *) mxGetPi(plhs[0]);
for (i=0;i<n; i++) {
pr[i]=sol[i].r;
pi[i]=sol[i].i;
}
/* second left hand side: src for matrix-vector multiplication or preconditioning */
plhs[1] =mxCreateDoubleMatrix(n,1, mxCOMPLEX);
pr = (double *) mxGetPr(plhs[1]);
pi = (double *) mxGetPi(plhs[1]);
workspace--;
for (i=0; i<n; i++) {
pr[i]=workspace[ipar[7]+i].r;
pi[i]=workspace[ipar[7]+i].i;
}
workspace++;
/* third left hand side: control parameter */
plhs[2] =mxCreateDoubleMatrix(1,1, mxREAL);
pr = (double *) mxGetPr(plhs[2]);
if (ipar[0]<=1)
*pr=ipar[0];
else if (ipar[0]==5)
*pr=2;
else if (ipar[0]==-1)
*pr=-1;
else if (ipar[0]==-2)
*pr=-2;
else if (ipar[0]>0)
*pr=ipar[0];
else
mexErrMsgTxt("undefined sqmr error code");
/* fourth left hand side: iter */
plhs[3] =mxCreateDoubleMatrix(1,1, mxREAL);
pr = (double *) mxGetPr(plhs[3]);
*pr=ipar[6];
/* fifth left hand side: relres */
plhs[4] =mxCreateDoubleMatrix(1,1, mxREAL);
pr = (double *) mxGetPr(plhs[4]);
*pr=fpar[4];
free(sol);
free(rhs);
/* if we finally decide to quit, the we release the workspace */
if (ipar[0]!=1 && ipar[0]!=5) {
init=0;
free(workspace);
}
return;
}
void mexFunction
(
/* === Parameters ======================================================= */
int nlhs, /* number of left-hand sides */
mxArray *plhs [], /* left-hand side matrices */
int nrhs, /* number of right--hand sides */
const mxArray *prhs [] /* right-hand side matrices */
)
{
Zmat A;
char *fname, rhstyp[4], title[81], key[9], type[4];
int i,j,k,l, mynrhs, status;
integer nrhsix, m, *rhsptr=NULL, *rhsind=NULL, ierr, nr,nc,nz, tmp,tmp0,tmp2,tmp3,ncolumns;
size_t mrows, ncols, sizebuf;
mwSize nnz, buflen;
mwIndex *irs, *jcs;
double *pr, *pi, *sr, *si;
doublecomplex *sol, *rhs=NULL, *rhsval=NULL;
mxArray *fout, *f_input;
FILE *fp;
if (nrhs!=1)
mexErrMsgTxt("Only one input argument required.");
else if (nlhs!=3)
mexErrMsgTxt("Three output arguments are required.");
else if (mxGetClassID(prhs[0])!=mxCHAR_CLASS)
mexErrMsgTxt("Input must be a string.");
/* get filename */
f_input = (mxArray *) prhs[0];
mrows = mxGetM (f_input) ;
ncols = mxGetN (f_input) ;
/* Get the length of the input string. */
buflen = (mrows*ncols) + 1;
/* Allocate memory for input and output strings. */
fname = (char *) mxCalloc((size_t)buflen, (size_t)sizeof(char));
/* Copy the string data from tmp into a C string pdata */
status = mxGetString(f_input, fname, buflen);
ncolumns = 0;
tmp0 = 0;
if ((fp=fopen(fname,"r"))==NULL) {
mexPrintf(" file %s",fname);
mexErrMsgTxt(" not found");
return;
}
fclose(fp);
rhstyp[0]=' ';
rhstyp[1]=' ';
rhstyp[2]=' ';
A.nc=0;
Zreadmtc(&tmp0,&tmp0,&tmp0,fname,A.a,A.ja,A.ia,
rhs,&ncolumns,rhstyp,&nr,&nc,&nz,title,key,type,
&nrhsix,rhsptr,rhsind,rhsval,&ierr,strlen(fname),2,72,8,3);
ncols=ncolumns;
/* if a right hand side is given, then use these */
if (ierr) {
mexPrintf(" ierr = %d\n",ierr);
mexErrMsgTxt(" error in reading the matrix, stop.\n");
switch(ierr) {
case 1:
mexErrMsgTxt("too many columns\n");
break;
case 2:
mexErrMsgTxt("too many nonzeros\n");
break;
case 3:
mexErrMsgTxt("too many columns and nonzeros\n");
break;
case 4:
mexErrMsgTxt("right hand side has incompatible type\n");
break;
case 5:
mexErrMsgTxt("too many right hand side entries\n");
break;
case 6:
mexErrMsgTxt("wrong type (real/complex)\n");
break;
}
exit(ierr);
}
if (ncols>0) {
m=1;
if (rhstyp[1]=='G' || rhstyp[1]=='g') {
m++;
}
if (rhstyp[2]=='X' || rhstyp[2]=='x') {
m++;
}
}
else
m=0;
m*=nr*ncols;
rhsptr=NULL;
rhsind=NULL;
rhsval=NULL;
if (ncols!=0 && (rhstyp[0]=='M' || rhstyp[0]=='m')) {
rhsptr=(integer *) MAlloc((size_t)(ncols+1)*sizeof(integer),"Zloadhbo:rhsptr");
rhsind=(integer *) MAlloc((size_t)nrhsix*sizeof(integer), "Zloadhbo:rhsind");
rhsval=(doublecomplex *) MAlloc((size_t)nrhsix*sizeof(doublecomplex), "Zloadhbo:rhsval");
}
A.ia=(integer *) MAlloc((size_t)(nc+1)*sizeof(integer), "Zloadhbo:A.ia");
A.ja=(integer *) MAlloc((size_t)nz*sizeof(integer), "Zloadhbo:A.ja");
A.a =(doublecomplex*)MAlloc((size_t)nz*sizeof(doublecomplex),"Zloadhbo:A.a");
A.nr=nr;
A.nc=nc;
rhs =(doublecomplex *)MAlloc((size_t)m*sizeof(doublecomplex),"Zloadhbo:rhs");
/* advance pointer to reserve space when uncompressing the right hand side */
if (ncols!=0 && (rhstyp[0]=='M' || rhstyp[0]=='m'))
rhs+=nr*ncols;
tmp = 3;
tmp2 = nc;
tmp3 = nz;
if (ncols!=0 && (rhstyp[0]=='M' || rhstyp[0]=='m'))
m-=nr*ncols;
Zreadmtc(&tmp2,&tmp3,&tmp,fname,A.a,A.ja,A.ia,
rhs,&m,rhstyp,&nr,&nc,&nz,title,key,type,
&nrhsix,rhsptr,rhsind,rhsval,&ierr,strlen(fname),2,72,8,3);
if (ncols!=0 && (rhstyp[0]=='M' || rhstyp[0]=='m'))
m+=nr*ncols;
if (ierr) {
mexPrintf(" ierr = %d\n",ierr);
mexErrMsgTxt(" error in reading the matrix, stop.\n");
return;
}
/* set output parameters */
nlhs=3;
fout =mxCreateSparse((mwSize)nr,(mwSize)nc, (mwSize)nz, mxCOMPLEX);
plhs[0]=fout;
sr = (double *) mxGetPr(fout);
si = (double *) mxGetPi(fout);
irs = (mwIndex *) mxGetIr(fout);
jcs = (mwIndex *) mxGetJc(fout);
jcs[0]=0;
for (i=0; i<nc; i++) {
jcs[i+1]=A.ia[i+1]-1;
for (j=A.ia[i]-1; j<A.ia[i+1]-1; j++) {
irs[j]=A.ja[j]-1;
sr[j] =A.a[j].r;
si[j] =A.a[j].i;
}
}
if (ncols>0) {
m=1;
if (rhstyp[1]=='G' || rhstyp[1]=='g') {
m++;
}
if (rhstyp[2]=='X' || rhstyp[2]=='x') {
m++;
}
}
else
m=0;
fout=mxCreateDoubleMatrix((mwSize)nr,(mwSize)m*ncols, mxCOMPLEX);
plhs[1]=fout;
if (ncols!=0 && (rhstyp[0]=='M' || rhstyp[0]=='m')) {
}
else {
pr = mxGetPr(fout);
pi = mxGetPi(fout);
for (i=0; i<nr*m*ncols; i++) {
pr[i]=rhs[i].r;
pi[i]=rhs[i].i;
}
}
rhstyp[3]='\0';
plhs[2] = mxCreateString(rhstyp);
free(A.a);
free(A.ia);
free(A.ja);
if (ncols>0)
free(rhs);
if (ncols!=0 && (rhstyp[0]=='M' || rhstyp[0]=='m')) {
free(rhsptr);
free(rhsind);
free(rhsval);
}
return;
}
U8 *DirNameAbs(U8 *_dirname)
{
I64 maxlen;
U8 drv[3],*cur_dir,*buf2,*buf3,*buf,*dirname,*temp_name;
if (!Fs->cur_dir || !*Fs->cur_dir)
return StrNew(_dirname);
dirname=MStrUtil(_dirname,
SUF_REM_LEADING|SUF_REM_TRAILING|SUF_REM_CTRL_CHARS);
temp_name=dirname;
*drv=Prt2Drv;
drv[1]=':';
drv[2]=0;
if (*dirname && dirname[1]==':') {
if (*dirname==':')
*drv=*sys_acct;
else
*drv=*dirname;
dirname=dirname+2;
cur_dir=StrNew("/");
} else
cur_dir=StrNew(Fs->cur_dir);
if (*dirname=='/') {
Free(cur_dir);
cur_dir=StrNew("/");
dirname++;
}
buf2=StrNew(dirname);
maxlen=StrLen(cur_dir)+1+StrLen(buf2)+1;
buf3=MAlloc(maxlen);
buf =MAlloc(maxlen);
StrCpy(buf3,cur_dir);
while (*buf2) {
StrFirstRem(buf2,"/",buf);
if (!*buf)
StrCpy(buf3,"/");
else if (!StrCmp(buf,"..")) {
StrLastRem(buf3,"/");
if (!*buf3)
StrCpy(buf3,"/");
} else if (!StrCmp(buf,".")) {
;
} else if (*buf) {
if (!StrCmp(buf,"HOME")) {
Free(buf3);
buf3=MAlloc(maxlen+StrLen(sys_acct));
StrCpy(buf3,sys_acct+2);
*drv=*sys_acct;
} else {
if (StrCmp(buf3,"/"))
StrCat(buf3,"/");
StrCat(buf3,buf);
}
}
}
Free(cur_dir);
cur_dir=MAlloc(StrLen(buf3)+3);
StrCpy(cur_dir,drv);
StrCpy(cur_dir+2,buf3);
Free(buf);
Free(buf2);
Free(buf3);
Free(temp_name);
return cur_dir;
}
int main(int argc, char*argv[]) {
char *gtm_fname=0;
for (int i=1;i<argc;i++) {
if (argv[i][0]!='-') {
if (gtm_fname==0) {
gtm_fname=argv[i];
} else {
fprintf(stderr, "ERROR: Only one input file is allowed\n.");
exit(1);
}
} else {
if (strcmp("-cost", argv[i])==0) {
const int no_costs=3;
i++;
if (argv[i][0]==0) {
printf("Cost tuple cannot be empty\n");
exit(1);
}
for (int j=0;j<strlen(argv[i]);j++) {
if (!isdigit(argv[i][j])) {
printf("Invalid cost tuple %s\n", argv[i]);
exit(1);
}
}
if (strlen(argv[i])%no_costs!=0) {
printf("Cost tuple %s length is not a multiple of %d.\n", argv[i], no_costs);
exit(1);
}
int d=strlen(argv[i])/no_costs;
switch_cost=0; visit_cost=0; absence_cost=0;
int j=0;
for (int k=0;k<d;k++) switch_cost=switch_cost*10+argv[i][j++]-'0';
for (int k=0;k<d;k++) absence_cost=absence_cost*10+argv[i][j++]-'0';
for (int k=0;k<d;k++) visit_cost=visit_cost*10+argv[i][j++]-'0';
//fprintf(stderr, "%d %d %d\n", switch_cost, absence_cost, visit_cost);
} else if (strcmp("-switch", argv[i])==0) {
assert(i+1<argc);
switch_cost=atoi(argv[++i]);
} else if (strcmp("-diff", argv[i])==0) {
assert(i+1<argc);
visit_cost=atoi(argv[++i]);
} else if (strcmp("-absence", argv[i])==0) {
assert(i+1<argc);
absence_cost=atoi(argv[++i]);
} else if (strcmp("-glimit", argv[i])==0) {
assert(i+1<argc);
glimit=atoi(argv[++i]);
assert(glimit>=0);
} else if (strcmp("-ilimit", argv[i])==0) {
assert(i+1<argc);
ilimit=atoi(argv[++i]);
assert(ilimit>=0);
} else if (strcmp("-1char", argv[i])==0) {
color_type = COLOR_1CHAR;
} else if (strcmp("-sep", argv[i])==0) {
color_type = COLOR_SEP;
} else if (strcmp("-q", argv[i])==0) {
quiet = 1;
ilimit = 0;
} else {
fprintf(stderr, "Unknown option %s\n", argv[i]);
print_usage(argv[0]);
}
}
}
if (gtm_fname==0) {
print_usage(argv[0]);
exit(1);
}
if (access(gtm_fname, F_OK)!=0) {
fprintf(stderr, "File %s does not exist\n", gtm_fname);
exit(1);
}
gtm_data gtm;
if (load_gtmfile(gtm_fname, >m)) {
printf("Error loading gtm file: %s\n", gtm_fname);
exit(1);
}
const int group_count = gtm.group_count;
const int ind_count = gtm.ind_count;
const int time_count = gtm.time_count;
const int *group_time = gtm.group_time;
const int *group_size = gtm.group_size;
int *ind_exists = gtm.ind_exists;
int *ind_time_group[ind_count];
for (int i=0;i<ind_count;i++) {
ind_time_group[i] = MAlloc(sizeof(int)*time_count);
for (int t=0;t<time_count;t++) {
ind_time_group[i][t]=-1;
}
}
linked_group *p=gtm.group_array[0];
for (int i=0;p!=0;p=p->next) {
for (int j=0;j<p->member_count;j++) {
//printf("i %d t %d g %d\n", p->member[j], p->timestep, i);
ind_time_group[p->member[j]][p->timestep]=i;
}
i++;
}
//
//for (int i=0;i<ind_count;i++) {
// for (int t=0;t<time_count;t++) {
// if (ind_time_group[i][t]<0) {
// printf(" %2c", '.');
// } else {
// printf(" %2d", ind_time_group[i][t]);
// }
// }
// printf("\n");
//}
//
int group_color[group_count];
memset(group_color, -1, sizeof(int)*group_count);
// detect color_type from stdin
if (color_type==COLOR_DEFAULT) {
color_type = detect_type_from_abc(100);
if (color_type==COLOR_DEFAULT) {
int nspace = detect_type_by_space_counting();
if (group_count-1 == nspace) {
color_type = COLOR_SEP;
} else if (time_count-1 == nspace) {
color_type = COLOR_1CHAR;
} else {
assertf(color_type, "Cannot detect color type.\n"
"ind_count %d time_count %d group_count %d nspace %d.\n"
"Use -sep or -1char.",
ind_count, time_count, group_count, nspace);
}
//fprintf(stderr, "detect %s\n",
// color_type==COLOR_1CHAR?"1char":(color_type==COLOR_SEP?"sep":"unknown"));
}
}
int gcount=0;
for (;;) {
// read a line of group colors
int rc = read_group_color(>m, group_color);
int color_count=0;
for (int g=0;g<group_count;g++) {
if (group_color[g]>color_count) color_count=group_color[g];
}
color_count++;
//if (color_count>ind_count) {
// fprintf(stderr, "WARNING! color_count %d > ind_count %d\n",
// color_count, ind_count);
//}
if (rc==-1) break;
if (rc==0) continue;
if (ilimit==1) {
process_group_color_limit1(>m, group_color, group_count,
color_count, &ind_time_group[0]);
break;
} else {
process_group_color_limitn(>m, group_color, group_count,
color_count, &ind_time_group[0]);
if (++gcount >= glimit) break;
printf("\n");
}
}
return 0;
}
U8 *FileRead(U8 *filename,I64 *_size=NULL,I64 *_attr=NULL,Bool raw=FALSE)
{
CHashGeneric *temph;
U8 *absname,*altname,*curname,*result=NULL;
I64 i,size=0,attr=0;
CFileAccess *fa;
CArcCompress *ac=NULL;
if (_attr) *_attr=0;
absname=FileNameAbs(filename);
altname=ToggleZorNotZ(absname);
if (!raw && ((temph=HashFind(absname,adam_task->hash_table,HTT_FILE))||
(temph=HashFind(altname,adam_task->hash_table,HTT_FILE)))) {
if (FileAttr(absname) & _ATTR_COMPRESSED) {
ac=temph->user_data0;
if (_size) *_size=ac->expanded_size;
if (_attr) *_attr=FileAttr(absname,*_attr);
result=ExpandBuf(ac);
} else {
result=MAlloc(temph->user_data1+1);
MemCpy(result,temph->user_data0,temph->user_data1);
result[temph->user_data1]=0; //Terminate
if (_size) *_size=temph->user_data1;
}
} else {
for (i=0;i<2 && !result;i++) {//Try name, then altname
if (!i)
curname=absname;
else
curname=altname;
if (fa=FileAccessNew(curname)) {
switch (fa->p->type) {
case PT_REDSEA:
result=RedSeaFSFileRead(fa->p,Fs->cur_dir,fa->mask,&size,&attr,raw,&ac);
break;
case PT_FAT32:
result=FAT32FileRead(fa->p,Fs->cur_dir,fa->mask,&size,&attr,raw,&ac);
break;
case PT_ISO9660:
result=ISO1FileRead(fa->p,Fs->cur_dir,fa->mask,&size,&attr,raw,&ac);
break;
default:
PutDefineErr("ST_UNSUPPORTED_FILE_SYSTEM");
}
FileAccessDel(fa);
}
}
//Search parent directories.
for (i=0;i<2 && !result;i++) {//Try name, then altname
if (!i)
curname=absname;
else
curname=altname;
if (fa=FileAccessNew(curname)) {
while (!result && StrCmp(Fs->cur_dir,"/")) {
Cd("..");
switch (Fs->cur_prt->type) {
case PT_REDSEA:
result=RedSeaFSFileRead(fa->p,Fs->cur_dir,fa->mask,&size,&attr,raw,&ac);
break;
case PT_FAT32:
result=FAT32FileRead(fa->p,Fs->cur_dir,fa->mask,&size,&attr,raw,&ac);
break;
case PT_ISO9660:
result=ISO1FileRead(fa->p,Fs->cur_dir,fa->mask,&size,&attr,raw,&ac);
break;
default:
PutDefineErr("ST_UNSUPPORTED_FILE_SYSTEM");
}
}
FileAccessDel(fa);
}
}
if (!result) {
"%s ",filename;
PutDefineErr("ST_FILE_NOT_FOUND");
}
if (_size) *_size=size;
if (_attr) *_attr=attr;
if (result && !raw && attr & _ATTR_RESIDENT)
HashGenericAdd(curname,HTT_FILE,AMAllocIdentical(ac),size,0,adam_task);
Free(ac);
}
Free(absname);
Free(altname);
return result;
}
U0 EdCodeTools2(CDoc *doc,I64 tool_action)
{
Bool okay,unlock=DocLock(doc),start_of_line=TRUE;
CDocEntry *doc_e,*doc_ne;
I64 i,start_y,end_y,x,r,goto_line_num;
U8 *b,*st,*st2,*prj_file;
CTask *task=NULL;
CSrvCmd *tempc;
CQueVectU8 *indent;
DocRecalc(doc);
goto_line_num=doc->cur_entry->y+1;
DocCaptureUndo(doc,TRUE);
switch (tool_action) {
case EF_CHK_COMPILE:
okay=FALSE;
if (doc->flags&DOCF_PLAIN_TEXT)
DocFlagsToggle(doc,DOCF_PLAIN_TEXT);
DocWrite(doc);
task=Spawn(&SrvUserCmdLine,NULL,"Srv",,Fs);
st2=CurDir;
st=MSPrintF("Cd(\"%s\");",st2);
tempc=TaskExeStrQue(task,Fs,st,1<<SVCf_WAKE_MASTER|1<<SVCf_FOCUS_MASTER);
Free(st2);
Free(st);
SetWinHorz(Fs->win_left,Fs->win_right, task);
SetWinVert(Fs->win_top, Fs->win_bottom,task);
if (ScanResult(tempc,&r)) {
st=DirFile(doc->filename.name,,"PRJ.Z"),
prj_file=FileNameAbs(st,FUF_Z_OR_NOT_Z);
Free(st);
if (FileFind(prj_file)) {
st2=DirFile(prj_file),
st=MSPrintF("Cd(\"%s\");",st2);
Free(st2);
tempc=TaskExeStrQue(task,Fs,st,1<<SVCf_WAKE_MASTER|1<<SVCf_FOCUS_MASTER|1<<SVCf_FREE_ON_COMPLETE);
Free(st);
st=MSPrintF("\"$$WW,1$$\";Cmp(\"%s\",\"SysTemp\",\"SysTemp\");",prj_file);
tempc=TaskExeStrQue(task,Fs,st,1<<SVCf_WAKE_MASTER|1<<SVCf_FOCUS_MASTER);
Free(st);
if (ScanResult(tempc,&r))
if (!r) {
tempc=TaskExeStrQue(task,Fs,
"Load(\"SysTemp\",LDF_JUST_LOAD);",1<<SVCf_WAKE_MASTER|1<<SVCf_FOCUS_MASTER);
if (ScanResult(tempc,&r))
okay=TRUE;
}
tempc=TaskExeStrQue(task,Fs,"Del(\"SysTemp.*\");",1<<SVCf_WAKE_MASTER|1<<SVCf_FOCUS_MASTER);
ScanResult(tempc,&r);
} else {
Free(prj_file);
st=DirFile(doc->filename.name,"Load","CPP.Z");
prj_file=FileNameAbs(st,FUF_Z_OR_NOT_Z);
Free(st);
if (FileFind(prj_file))
st=MSPrintF("\"$$WW,1$$\";ExeFile(\"%s\",TRUE);",prj_file);
else
st=MSPrintF("\"$$WW,1$$\";ExeFile(\"%s\",TRUE);",doc->filename.name);
tempc=TaskExeStrQue(task,Fs,st,1<<SVCf_WAKE_MASTER|1<<SVCf_FOCUS_MASTER);
Free(st);
if (ScanResult(tempc,&r) && r)
okay=TRUE;
}
Free(prj_file);
}
if (!okay) {
PopUpOk("Has Errors");
while (LBts(&sys_semas[SYS_SEMA_FIX],0))
Yield;
ToFileLine(sys_fix_file_line,&st,&i);
LBtr(&sys_semas[SYS_SEMA_FIX],0);
if (!StrCmp(st,doc->filename.name))
goto_line_num=i;
Free(st);
}
break;
case EF_REINDENT:
if (EdGoToFun(doc,FALSE,FALSE)) {
start_y=doc->cur_entry->y;
indent=EdRICode(doc);
DocUnlock(doc);
Snd(2000); Sleep(150); Snd(0);
Sleep(100);
Snd(2000); Sleep(150); Snd(0);
DocLock(doc);
EdRemFunLeadingSpace(doc);
DocLineNumGoTo(doc,start_y+1);
doc_e=doc->cur_entry;
end_y=start_y+indent->total_cnt;
while (start_y<=doc_e->y<end_y) {
if (doc_e!=doc && doc_e!=doc->cur_entry &&
!(doc_e->flags1&(DOCEG1_DONT_EDIT-DOCEF1_SCROLLING_X)) &&
!(doc_e->flags2&DOCEG2_DONT_EDIT)) {
if (doc_e->type_u8==DOCT_NEW_LINE||doc_e->type_u8==DOCT_SOFT_NEW_LINE)
start_of_line=TRUE;
else {
if (start_of_line) {
i=QueVectU8Get(indent,doc_e->y)*C_INDENT_SPACES;
x=doc_e->x+1;
while (i>8) {
doc_ne=CAlloc(sizeof(CDocEntryBase),doc->mem_task);
doc_ne->type=DOCT_TAB | doc->settings_root.dft_text_attr << 8;
doc_ne->x=x;
doc_ne->y=doc_e->y;
doc_ne->page_line_num=doc_e->page_line_num;
QueIns(doc_ne,doc_e->last);
i-=8;
x+=8;
}
if (i>0) {
b=MAlloc(i+1,doc->mem_task);
MemSet(b,CH_SPACE,i);
b[i]=0;
doc_ne=CAlloc(sizeof(CDocEntryBase),doc->mem_task);
doc_ne->type=DOCT_TEXT | doc->settings_root.dft_text_attr << 8;
doc_ne->tag=b;
doc_ne->max_col=1;
doc_ne->x=x;
doc_ne->y=doc_e->y;
doc_ne->page_line_num=doc_e->page_line_num;
QueIns(doc_ne,doc_e->last);
}
}
start_of_line=FALSE;
}
}
doc_e=doc_e->next;
}
QueVectU8Del(indent);
}
break;
case EF_RENUM_ASM:
if (EdGoToFun(doc,FALSE,TRUE)) {
if (EdCurU8(doc)=='{') {
EdCursorRight(doc);
DocRecalc(doc);
} else if (EdCurU8(doc)==':') {
EdCursorRight(doc);
if (EdCurU8(doc)==':')
EdCursorRight(doc);
DocRecalc(doc);
}
DocUnlock(doc);
Snd(2000); Sleep(150); Snd(0);
Sleep(100);
Snd(2000); Sleep(150); Snd(0);
DocLock(doc);
EdRenumAsm(doc);
}
break;
}
void mexFunction
(
/* === Parameters ======================================================= */
int nlhs, /* number of left-hand sides */
mxArray *plhs [], /* left-hand side matrices */
int nrhs, /* number of right--hand sides */
const mxArray *prhs [] /* right-hand side matrices */
)
{
Dmat A;
DILUPACKparam param;
mxArray *A_input;
integer *p, *invq, nB=0;
double *prowscale, *pcolscale;
int ierr, i,j,k,l;
size_t mrows, ncols;
mwSize nnz;
double *pr, *D, *A_a;
mwIndex *A_ia, *A_ja;
if (nrhs != 1)
mexErrMsgTxt("One input argument required.");
else if (nlhs!=2)
mexErrMsgTxt("Two output arguments are required.");
else if (!mxIsNumeric(prhs[0]))
mexErrMsgTxt("First input must be a matrix.");
/* The first input must be a square matrix.*/
A_input=(mxArray *)prhs[0];
mrows = mxGetM(A_input);
ncols = mxGetN(A_input);
nnz = mxGetNzmax(A_input);
if (mrows!=ncols) {
mexErrMsgTxt("First input must be a square matrix.");
}
A_ja = (mwIndex *)mxGetIr(A_input);
A_ia = (mwIndex *)mxGetJc(A_input) ;
A_a = (double *) mxGetPr(A_input) ;
A.nc=A.nr=mrows;
A.ia=(integer *)MAlloc((size_t)(A.nc+1)*sizeof(integer),"symmwmilupackmetisn");
A.ja=(integer *)MAlloc((size_t)nnz *sizeof(integer),"symmwmilupackmetisn");
A.a =(double *) MAlloc((size_t)nnz *sizeof(double), "symmwmilupackmetisn");
A.ia[0]=1;
for (i = 0 ; i < ncols ; i++) {
A.ia[i+1]=A.ia[i];
for (j = A_ia[i] ; j < A_ia[i+1] ; j++) {
/* a_ik */
k=A_ja[j];
if (k>=i) {
l=A.ia[i+1]-1;
A.ja[l]=k+1;
A.a[l]=A_a[j];
A.ia[i+1]=l+2;
}
}
}
/* init parameters to their default values */
DSYMAMGinit(&A,¶m);
p =(integer *) MAlloc((size_t)A.nc*sizeof(integer),"symmwmilupackmetisn");
invq=(integer *) MAlloc((size_t)A.nc*sizeof(integer),"symmwmilupackmetisn");
pcolscale=(double *) MAlloc((size_t)A.nc*sizeof(double),"symmwmilupackmetisn");
prowscale=pcolscale;
#ifdef _MC64_MATCHING_
ierr=DSYMperm_mc64_metis_n(A, prowscale, pcolscale, p, invq, &nB, ¶m);
#elif defined _PARDISO_MATCHING_
ierr=DSYMperm_mwm_metis_n(A, prowscale, pcolscale, p, invq, &nB, ¶m);
#else /* MUMPS matching */
ierr=DSYMperm_matching_metis_n(A, prowscale, pcolscale, p, invq, &nB, ¶m);
#endif
/* Create output vector */
nlhs=2;
plhs[0] =mxCreateDoubleMatrix(1,mrows, mxREAL);
pr = (double *) mxGetPr(plhs[0]);
for (i=0;i<mrows; i++)
pr[i]=p[i];
plhs[1] =mxCreateDoubleMatrix(mrows,1, mxREAL);
D = (double *) mxGetPr(plhs[1]);
for (i=0;i<mrows; i++)
D[i]=pcolscale[i];
free(p);
free(invq);
free(prowscale);
free(A.ia);
free(A.ja);
return;
}
