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);
}
Beispiel #2
0
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;
}
Beispiel #4
0
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;
    }
  }
}
Beispiel #6
0
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;
}
Beispiel #8
0
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;
}
Beispiel #9
0
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;
}
Beispiel #10
0
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;
}
Beispiel #11
0
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;
}
Beispiel #12
0
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);
}
Beispiel #13
0
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);
}
Beispiel #14
0
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);
	}
}
Beispiel #15
0
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;
}
Beispiel #16
0
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;
}
Beispiel #17
0
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);
}
Beispiel #19
0
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;
}
Beispiel #20
0
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 {
Beispiel #21
0
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;
}
Beispiel #22
0
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(&param, 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;
}
Beispiel #23
0
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;
}
Beispiel #24
0
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;
}
Beispiel #25
0
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;
}
Beispiel #26
0
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;
}
Beispiel #27
0
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, &gtm)) {
		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(&gtm, 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(&gtm, group_color, group_count, 
				color_count, &ind_time_group[0]);
			break;
		} else {
			process_group_color_limitn(&gtm, group_color, group_count, 
				color_count, &ind_time_group[0]);
			if (++gcount >= glimit) break;
			printf("\n");
		}
	}

	return 0;
}
Beispiel #28
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;
  }
Beispiel #30
0
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,&param);

    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, &param);
#elif defined _PARDISO_MATCHING_
    ierr=DSYMperm_mwm_metis_n(A, prowscale, pcolscale, p, invq, &nB, &param);
#else /* MUMPS matching */
    ierr=DSYMperm_matching_metis_n(A, prowscale, pcolscale, p, invq, &nB, &param);
#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;
}