/*------------------------------------------------------------------------ * Graphic library * Copyright (C) 1998-2000 Enpc/Inria * jpc@cereve.enpc.fr --------------------------------------------------------------------------*/ /*------------------------------------------------------ * Read and Write inside the Scilab stack *------------------------------------------------------*/ #include #include "../stack-c.h" extern int C2F(dmcopy) __PARAMS((double *a, integer *na, double *b, integer *nb, integer *m, integer *n)); extern int C2F(stackg) __PARAMS((integer *id)); extern int C2F(stackp) __PARAMS((integer *id, integer *macmod)); /* Table of constant values */ static integer cx0 = 0; static integer cx1 = 1; /*------------------------------------------------------ * read a matrix *------------------------------------------------------*/ int C2F(readmat)(namex, m, n, scimat, name_len) char *namex; integer *m, *n; double *scimat; unsigned long name_len; { int j; j = C2F(creadmat)(namex, m, n, scimat, name_len); return 0; } /*---------------------------------------------------------------- * readmat reads vector/matrix in scilab's internal stack * calling sequence * logic=creadmat('matrixname',m,n,scimat) * matrixname: character string; name of the scilab variable. * m: number of rows (output of readmat) * n: number of columns (output of readmat) * scimat: matrix entries stored columnwise (output of readmat) * Example of use: * Amat is a real 2 x 3 scilab matrix * your subroutine should be as follows: * subroutine mysubr(...) * ... * call readmat('Amat',m,n,scimat) * => m=3 , n=2, and scimat(1)=Amat(1,1) * scimat(2)=Amat(2,1) * scimat(3)=Amat(3,1) * scimat(4)=Amat(1,2) ... * scimat(5)=Amat(3,2) * scimat(6)=Amat(3,2) *----------------------------------------------------------------*/ int C2F(creadmat)(namex, m, n, scimat, name_len) char *namex; integer *m, *n; double *scimat; unsigned long name_len; { integer l; integer id[nsiz]; C2F(str2name)(namex, id, name_len); /* read : from scilab stack -> fortran variable */ Fin = -1; C2F(stackg)(id); if (Err > 0) return FALSE_ ; if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); return FALSE_; } if ( *Infstk(Fin ) == 2) Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); /* get matrix data pointer */ if (! C2F(getrmat)("creadmat", &Fin, &Fin, m, n, &l, 8L)) return FALSE_; C2F(dmcopy)(stk(l ), m, scimat, m, m, n); return TRUE_; } /*---------------------------------------------------------------- * creadcmat reads vector/matrix in scilab's internal stack * calling sequence * logic=creadcmat('matrixname',m,n,scimat) * matrixname: character string; name of the scilab variable. * m: number of rows (output of readmat) * n: number of columns (output of readmat) * scimat: matrix entries stored columnwise (output of readmat) * Example of use: * Amat is a real 2 x 3 scilab matrix * your subroutine should be as follows: * subroutine mysubr(...) * ... * call readmat('Amat',m,n,scimat) * => m=3 , n=2, and scimat(1)=Amat(1,1) * scimat(2)=Amat(2,1) * scimat(3)=Amat(3,1) * scimat(4)=Amat(1,2) ... * scimat(5)=Amat(3,2) * * Note d'Albert Y * 20/12/2003 * Cette routine est une simple copie de creadmat et légèrement * modifiée pour les matrices complexes * *----------------------------------------------------------------*/ int C2F(creadcmat)(namex, m, n, scimat, name_len) char *namex; integer *m, *n; double *scimat; unsigned long name_len; { integer l, ix1; integer id[nsiz]; C2F(str2name)(namex, id, name_len); /* read : from scilab stack -> fortran variable */ Fin = -1; C2F(stackg)(id); if (Err > 0) return FALSE_ ; if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); return FALSE_; } if ( *Infstk(Fin ) == 2) Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); /* get matrix data pointer */ if (! C2F(getcmat)("creadcmat", &Fin, &Fin, m, n, &l, 8L)) return FALSE_; ix1 = *m * *n; C2F(dmcopy)(stk(l ), m, scimat, m, m, n); C2F(dmcopy)(stk(l+ix1 ), m, scimat+ix1, m, m, n); return TRUE_; } /*---------------------------------------------------------------- * cwritemat writes vector/matrix in scilab's internal stack * logic=cwritemat('matrixname'//char(0),m,n,mat) * name: character string; name of the scilab variable ( null terMinated) * m: number of rows * n: number of columns * mat: matrix entries stored columnwise in Scilab object *----------------------------------------------------------------*/ int C2F(cwritemat)(namex, m, n, mat, name_len) char *namex; integer *m, *n; double *mat; unsigned long name_len; { integer ix1 = *m * *n; integer Rhs_k = Rhs , Top_k = Top ; integer l4, id[nsiz], lc, lr; C2F(str2name)(namex, id, name_len); /* jpc april 2002 */ /* ++Top; */ Top = Top + Nbvars + 1; if (! C2F(cremat)("cwritemat", &Top, &cx0, m, n, &lr, &lc, 9L)) return FALSE_; C2F(dcopy)(&ix1, mat, &cx1, stk(lr ), &cx1); Rhs = 0; l4 = C2F(iop).lct[3]; C2F(iop).lct[3] = -1; C2F(stackp)(id, &cx0); C2F(iop).lct[3] = l4; Top = Top_k; Rhs = Rhs_k; if (Err > 0) return FALSE_; return TRUE_; } /*-----------------------------------------------------------------------------------*/ /** * cwritecmat writes vector/matrix in scilab's internal stack * name: character string; name of the scilab variable ( null terMinated) * m: number of rows * n: number of columns * mat: matrix entries stored columnwise in Scilab object * for complex number */ /*-----------------------------------------------------------------------------------*/ int C2F(cwritecmat)(char *namex,integer *m, integer*n,double *mat,unsigned long name_len) { integer ix1 = *m * *n *2; /* real part + imaginary part */ integer Rhs_k = Rhs , Top_k = Top ; integer l4, id[nsiz], lc, lr; int IT=1; /* Type Complex */ C2F(str2name)(namex, id, name_len); Top = Top + Nbvars + 1; if (! C2F(cremat)("cwritecmat", &Top, &IT, m, n, &lr, &lc, 10L)) return FALSE_; C2F(dcopy)(&ix1, mat, &cx1, stk(lr ), &cx1); Rhs = 0; l4 = C2F(iop).lct[3]; C2F(iop).lct[3] = -1; C2F(stackp)(id, &cx0); C2F(iop).lct[3] = l4; Top = Top_k; Rhs = Rhs_k; if (Err > 0) return FALSE_; return TRUE_; } /*-----------------------------------------------------------------------------------*/ int C2F(putvar)(number, namex, name_len) /* Put variable number into Scilab internal stack with name "namex" */ char *namex; int *number; unsigned long name_len; { integer Rhs_k = Rhs , Top_k = Top ; integer l4, id[nsiz],/* lc, lr,*/ cx0=1; C2F(str2name)(namex, id, name_len); Top = *number + Top -Rhs; Rhs = 0; l4 = C2F(iop).lct[3]; C2F(iop).lct[3] = -1; C2F(stackp)(id, &cx0); C2F(iop).lct[3] = l4; Top = Top_k; Rhs = Rhs_k; if (Err > 0) return FALSE_; return TRUE_; } /*------------------------------------------------------ * see creadchain *------------------------------------------------------*/ int C2F(readchain)(namex, itslen, chai, name_len, chai_len) char *namex; integer *itslen; char *chai; unsigned long name_len, chai_len; { int j; j = C2F(creadchain)(namex, itslen, chai, name_len, chai_len); return 0; } /*------------------------------------------------------ * this routine reads a string in scilab's memory * and store it into chai * !calling sequence * integer itslen * character*(*) chai,name * name : character string = name of scilab variable (input) * chai : chain to be read (output) * null terMinated * itslen : (input) Maximum number of character that can ne stored * in chain * (output) number of copied characters into chai * if Scilab variable x='qwert' exists * character ch*(10) * l=10 * logic= creadchain('x',l,ch) returns l=5 and ch='qwert' *------------------------------------------------------*/ int C2F(creadchain)(namex, itslen, chai, name_len, chai_len) char *namex; integer *itslen; char *chai; unsigned long name_len; unsigned long chai_len; { integer ix1; integer m1, n1; integer id[nsiz]; integer lr1; integer nlr1; Err = 0; C2F(str2name)(namex, id, name_len); Fin = -1; C2F(stackg)(id); if (Err > 0) return FALSE_ ; if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); return FALSE_ ; } if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } if (! C2F(getsmat)("creadchain", &Fin, &Fin, &m1, &n1, &cx1, &cx1, &lr1, &nlr1, 10L)) { return FALSE_; } if (m1 * n1 != 1) { Scierror(999,"creadchain: argument must be a string\r\n"); return FALSE_ ; } ix1 = *itslen - 1; *itslen = Min(ix1,nlr1); C2F(cvstr)(itslen, istk(lr1 ), chai, &cx1, chai_len); chai[*itslen] = '\0'; return TRUE_ ; } /*---------------------------------------------------------------------- * this routine reads name(ir,ic) in scilab's memory * and store it into chai * if ir=ic=-1 on entry then the routines returns in ir,ic * the size of the matrix * !calling sequence * integer itslen * character*(*) chai,name * name : character string = name of scilab variable (input) * chai : chain to be read (output) * null terMinated * itslen : (input) Maximum number of character that can be stored * in chain * (output) number of copied characters into chai * if Scilab variable x='qwert' exists * character ch*(10) * l=10 * logic= creadchain('x',l,ch) returns l=5 and ch='qwert' *----------------------------------------------------------------------*/ int C2F(creadchains)(namex, ir, ic, itslen, chai, name_len, chai_len) char *namex; integer *ir, *ic, *itslen; char *chai; unsigned long name_len; unsigned long chai_len; { integer ix1; integer m1, n1; integer id[nsiz]; integer lr1; integer nlr1; Err = 0; C2F(str2name)(namex, id, name_len); Fin = -1; C2F(stackg)(id); if (Err > 0) return FALSE_ ; if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); return FALSE_ ; } if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } if (*ir == -1 && *ic == -1) { if (! C2F(getsmat)("creadchain", &Fin, &Fin, ir, ic, &cx1, &cx1, &lr1, &nlr1, 10L)) return FALSE_; else return TRUE_ ; } else { if (! C2F(getsmat)("creadchain", &Fin, &Fin, &m1, &n1, ir, ic, &lr1, &nlr1, 10L)) { return FALSE_; } } ix1 = *itslen - 1; *itslen = Min(ix1,nlr1); C2F(cvstr)(itslen, istk(lr1 ), chai, &cx1, chai_len); chai[*itslen]='\0'; return TRUE_; } /*---------------------------------------------------------------- * cwritemat writes vector/matrix in scilab's internal stack * logic=cwritemat('matrixname'//char(0),m,n,mat) * name: character string; name of the scilab variable ( null terMinated) * m: number of rows * n: number of columns * mat: matrix entries stored columnwise in Scilab object *----------------------------------------------------------------*/ int C2F(cwritechain)(namex, m, chai, name_len, chai_len) char *namex; integer *m; char *chai; unsigned long name_len, chai_len; { integer Rhs_k, Top_k; integer l4; integer id[nsiz], lr; C2F(str2name)(namex, id, name_len); Top_k = Top; /* jpc april 2002 */ /* ++Top; */ Top = Top + Nbvars + 1; if (! C2F(cresmat2)("cwritechain", &Top, m, &lr, 11L)) { return FALSE_; } C2F(cvstr)(m, istk(lr ), chai, &cx0, chai_len); Rhs_k = Rhs; Rhs = 0; l4 = C2F(iop).lct[3]; C2F(iop).lct[3] = -1; C2F(stackp)(id, &cx0); C2F(iop).lct[3] = l4; Top = Top_k ; Rhs = Rhs_k ; if (Err > 0) return FALSE_; return TRUE_ ; } /*---------------------------------------------------------------- * see cmatptr *----------------------------------------------------------------*/ int C2F(matptr)(namex, m, n, lp, name_len) char *namex; integer *m, *n, *lp; unsigned long name_len; { int ix; ix = C2F(cmatptr)(namex, m, n, lp, name_len); return 0; } /*---------------------------------------------------------------- * !purpose * matptr returns the adress of real matrix "name" * in scilab's internal stack * m=number of rows * n=number of columns * stk(lp),stk(lp+1),...,stk(lp+m*n-1)= entries (columnwise) * If matrix "name" not in Scilab stack, returns m=n=-1. * Example of use: * Amat is a real 2 x 3 scilab matrix * your subroutine should be as follows: * subroutine mysubr(...) * ... * logic= cmatptr('Amat',m,n,lp) * => m=3 , n=2, and stk(lp)=Amat(1,1) * stk(lp+1)=Amat(2,1) * stk(lp+2)=Amat(3,1) * stk(lp+3)=Amat(1,2) ... * stk(lp+5)=Amat(3,2) * see example in fydot.f file * see also readmat.f, matz.f *----------------------------------------------------------------*/ int C2F(cmatptr)(namex, m, n, lp, name_len) char *namex; integer *m, *n, *lp; unsigned long name_len; { integer id[nsiz]; C2F(str2name)(namex, id, name_len); /* get the position in fin */ Fin = -1; C2F(stackg)(id); if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); *m = -1; *n = -1; return FALSE_; } /* get data */ if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } if (! C2F(getrmat)("creadmat", &Fin, &Fin, m, n, lp, 8L)) { return FALSE_; } return TRUE_ ; } /*---------------------------------------------------------------- * !purpose * cmatcptr returns the adress of complex matrix "name" * in scilab's internal stack * m=number of rows * n=number of columns * stk(lp),stk(lp+1),...,stk(lp+m*n-1)= entries (columnwise) * If matrix "name" not in Scilab stack, returns m=n=-1. * Example of use: * Amat is a real 2 x 3 scilab matrix * your subroutine should be as follows: * subroutine mysubr(...) * ... * logic= cmatptr('Amat',m,n,lp) * => m=3 , n=2, and stk(lp)=Amat(1,1) * stk(lp+1)=Amat(2,1) * stk(lp+2)=Amat(3,1) * stk(lp+3)=Amat(1,2) ... * stk(lp+5)=Amat(3,2) * see example in fydot.f file * see also readmat.f, matz.f * * Note d'Albert Y * 20/12/2003 * Cette routine est une simple copie de creadmat et légèrement * modifiée pour les matrices complexes * *----------------------------------------------------------------*/ int C2F(cmatcptr)(namex, m, n, lp, name_len) char *namex; integer *m, *n, *lp; unsigned long name_len; { integer id[nsiz]; C2F(str2name)(namex, id, name_len); /* get the position in fin */ Fin = -1; C2F(stackg)(id); if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); *m = -1; *n = -1; return FALSE_; } /* get data */ if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } if (! C2F(getcmat)("creadmat", &Fin, &Fin, m, n, lp, 8L)) { return FALSE_; } return TRUE_ ; } /*---------------------------------------------------------------- * !purpose * matptr returns the adress of real matrix "name" * in scilab's internal stack * m=number of rows * n=number of columns * stk(lp),stk(lp+1),...,stk(lp+m*n-1)= entries (columnwise) * If matrix "name" not in Scilab stack, returns m=n=-1. * Example of use: * Amat is a real 2 x 3 scilab matrix * your subroutine should be as follows: * subroutine mysubr(...) * ... * logic= cmatptr('Amat',m,n,lp) * => m=3 , n=2, and stk(lp)=Amat(1,1) * stk(lp+1)=Amat(2,1) * stk(lp+2)=Amat(3,1) * stk(lp+3)=Amat(1,2) ... * stk(lp+5)=Amat(3,2) * see example in fydot.f file * see also readmat.f, matz.f *----------------------------------------------------------------*/ int C2F(cmatsptr)(namex, m, n, ix, j, lp, nlr, name_len) char *namex; integer *m, *n, *lp, *ix, *j, *nlr; unsigned long name_len; { integer id[nsiz]; C2F(str2name)(namex, id, name_len); /* get the position in fin */ Fin = -1; C2F(stackg)(id); if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); *m = -1; *n = -1; return FALSE_; } /* get data */ if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } if (! C2F(getsmat)("creadmat", &Fin, &Fin, m, n, ix, j, lp, nlr, 8L)) { return FALSE_; } return TRUE_ ; } void *Name2ptr(namex) char *namex; /* Returns a pointer to the Scilab variable with name namex Usage: int *header; header = (int *) Name2ptr("pipo"); header[0], header[1], etc contains header info about Scilab variable "pipo" */ { int l1; int *loci; integer id[nsiz]; C2F(str2name)(namex, id, strlen(namex)); /* get the position in fin */ Fin = -1; C2F(stackg)(id); if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,strlen(namex))); return 0; } /* get data */ if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } loci = (int *) stk(*Lstk(Fin)); if (loci[0] < 0) { l1 = loci[1]; loci = (int *) stk(l1); } return loci; } int Name2where(namex) /* returns the position in the internal stack of the variable with name namex Usage: int l=Name2where("pipo"); stk(l) points to Scilab variable named "pipo" e.g. if pipo is a standard real matrix stk(l)[2]=first entry of the matrix pipo(1,1) stk(l)[3]=pipo(2,1) etc (The header of pipo is given by istk(iadr(h))[0], istk(iadr(h))[1], etc ) */ char *namex; /* unsigned long name_len; */ { int loci; integer id[nsiz]; C2F(str2name)(namex, id, strlen(namex)); /* get the position in fin */ Fin = -1; C2F(stackg)(id); if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,strlen(namex))); return 0; } loci = *Lstk(Fin); return loci; } /*---------------------------------------------------------------- * string conversion to Scilab ID * Warning : the character name is null terMinated * and len(name) is not used * since it can be wrong (ex when name is transmited * by fort (intfort : function ) *----------------------------------------------------------------*/ int C2F(str2name)(namex, id, name_len) char *namex; integer *id; unsigned long name_len; { integer ix; integer lon; lon = 0; for (ix = 0 ; ix < (integer) name_len ; ix++ ) { if ( namex[ix] == '\0') break; ++lon; } C2F(cvname)(id, namex, &cx0, lon); return 0; } /*---------------------------------------------------------------- * objptr returns the adress of "name" * in scilab's internal stack *----------------------------------------------------------------*/ int C2F(objptr)(namex, lp, fin, name_len) char *namex; integer *lp; integer *fin; unsigned long name_len; { integer id[nsiz]; *lp = 0; /* ---- get the id */ C2F(str2name)(namex, id, name_len); /* ---- get the position in fin */ Fin = -1; C2F(stackg)(id); if (Fin == 0) { C2F(putid)(&C2F(recu).ids[(C2F(recu).pt + 1) * nsiz - nsiz], id); /* we juste return false and lp is set to zero */ /* call error(4) */ return FALSE_; } *fin = Fin; *lp = *Lstk(Fin ); if (*Infstk(Fin ) == 2) { *lp = *Lstk(*istk(iadr(*lp) + 1 +1) ); } return TRUE_; } /*-----------------------------------------------------------------------------------*/ /* read and write a boolean matrix in scilab stack */ /*-----------------------------------------------------------------------------------*/ int C2F(creadbmat)(char *namex, integer *m, integer *n, int *scimat, unsigned long name_len) { integer l = 0; integer id[nsiz]; int c_x = 1; int N = 0; C2F(str2name)(namex, id, name_len); /* read : from scilab stack -> fortran variable */ Fin = -1; C2F(stackg)(id); if (Err > 0) return FALSE_ ; if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); return FALSE_; } if ( *Infstk(Fin ) == 2) Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); /* get matrix data pointer */ if (! C2F(getbmat)("creadbmat", &Fin, &Fin, m, n, &l , 9L)) return FALSE_; N = *n * *m; C2F(icopy)(&N,istk(l),&c_x,scimat,&c_x); return TRUE_; } /*-----------------------------------------------------------------------------------*/ int C2F(cwritebmat)(char *namex, integer *m, integer *n, int *mat, unsigned long name_len) { integer ix1 = *m * *n; integer Rhs_k = Rhs , Top_k = Top ; integer l4, id[nsiz], lr; C2F(str2name)(namex, id, name_len); Top = Top + Nbvars + 1; if (! C2F(crebmat)("cwritebmat", &Top, m, n, &lr, 10L)) return FALSE_; C2F(icopy)(&ix1, mat, &cx1, istk(lr ), &cx1); Rhs = 0; l4 = C2F(iop).lct[3]; C2F(iop).lct[3] = -1; C2F(stackp)(id, &cx0); C2F(iop).lct[3] = l4; Top = Top_k; Rhs = Rhs_k; if (Err > 0) return FALSE_; return TRUE_; } /*-----------------------------------------------------------------------------------*/ int C2F(cmatbptr)(char *namex, integer *m,integer *n,integer *lp, unsigned long name_len) { integer id[nsiz]; C2F(str2name)(namex, id, name_len); /* get the position in fin */ Fin = -1; C2F(stackg)(id); if (Fin == 0) { Scierror(4,"Undefined variable %s\r\n",get_fname(namex,name_len)); *m = -1; *n = -1; return FALSE_; } /* get data */ if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } if (! C2F(getbmat)("creadbmat", &Fin, &Fin, m, n, lp , 9L)) return FALSE_; return TRUE_ ; } /*-----------------------------------------------------------------------------------*/ /** returns length of a "chain variable" in scilab example : in scilab --> str = "abcdefghijklmnopqrstuvwxyz"; in C getlengthchain("str") returns 26 error returns -1 */ int getlengthchain(char *namex) { int retLength = -1; integer m1, n1; integer id[nsiz]; integer lr1; integer nlr1; unsigned long name_len= strlen(namex); Err = 0; C2F(str2name)(namex, id, name_len); Fin = -1; C2F(stackg)(id); if (Err > 0) return -1; if (Fin == 0) return -1; if (*Infstk(Fin ) == 2) { Fin = *istk(iadr(*Lstk(Fin )) + 1 +1); } if (! C2F(getsmat)("getlengthchain", &Fin, &Fin, &m1, &n1, &cx1, &cx1, &lr1, &nlr1, 14L)) return -1; if (m1 * n1 != 1) return -1; retLength = nlr1; return retLength; } /*-----------------------------------------------------------------------------------*/