Scilab [trunk]: scilab/modules/statistics/src/c/CdfBase.c Source File

00001 /*-----------------------------------------------------------------------------------*/
00002 /* INRIA 2006 */
00003 /*-----------------------------------------------------------------------------------*/ 
00004 #include <string.h>
00005 #include "machine.h"
00006 #include "stack-c.h"
00007 /*-----------------------------------------------------------------------------------*/ 
00008 int  CdfBase(char *fname,int inarg,int oarg,int *callpos,char *option,char *errnames,int which,int (*fonc)(),void (*foncErr)() )
00009 {
00010         int i,status=0,m[6],n[6],l[6];
00011         double bound;
00012         if ( Rhs != inarg+1 ) 
00013         {
00014                 Scierror(999,"%s: Rhs must be %d for '%s' option'\r\n",fname,inarg+1,option);
00015                 return 1;
00016         }
00017         for ( i = 0 ; i < inarg ; i++ )
00018         {
00019                 GetRhsVar(i+2, "d", &m[i], &n[i], &l[i]);
00020         }
00021         for ( i = 1 ; i < inarg ; i++) 
00022                 if ( m[i] != m[i-1] || n[i] != n[i-1]) 
00023                 {
00024                         Scierror(999,"%s %s must have same size\r\n",fname,errnames);
00025                         return 1;
00026                 } 
00027                 for ( i = 0 ; i < oarg ; i++) 
00028                         CreateVar(i+2+inarg,"d",&m[0],&n[0],&l[i+inarg]);
00029                 switch ( inarg+oarg) 
00030                 {
00031                 case 5:
00032                         for ( i=0 ; i < m[0]*n[0]; i++) 
00033                         {
00034                                 (*fonc)(&which,stk(l[callpos[0]]+i),stk(l[callpos[1]]+i),
00035                                         stk(l[callpos[2]] +i),stk(l[callpos[3]]+i),
00036                                         stk(l[callpos[4]]+i),
00037                                         &status,&bound);
00038                                 if (status != 0) 
00039                                 {
00040                                         (*foncErr)(status,bound); return 1;
00041                                 }
00042                         }
00043                         break;
00044                 case 6:
00045                         for ( i=0 ; i < m[0]*n[0]; i++) 
00046                         {
00047                                 (*fonc)(&which,stk(l[callpos[0]]+i),stk(l[callpos[1]]+i),
00048                                         stk(l[callpos[2]] +i),stk(l[callpos[3]]+i),
00049                                         stk(l[callpos[4]] +i),stk(l[callpos[5]]+i),
00050                                         &status,&bound);
00051                                 if (status != 0) 
00052                                 {
00054                                         (*foncErr)(status,bound); return 1;
00055                                 }
00056                         }
00057                         break;
00058                 case 4:
00059                         for ( i=0 ; i < m[0]*n[0]; i++) 
00060                         {
00061                                 (*fonc)(&which,stk(l[callpos[0]]+i),stk(l[callpos[1]]+i),
00062                                         stk(l[callpos[2]] +i),stk(l[callpos[3]]+i),
00063                                         &status,&bound);
00064                                 if (status != 0) 
00065                                 {
00066                                         (*foncErr)(status,bound); return 1;
00067                                 }
00068                         }
00069                         break;
00070                 }
00071                 for ( i = 0 ; i < oarg ; i++) 
00072                         LhsVar(i+1) = i+2+inarg;
00073                 PutLhsVar();
00074                 return 0;
00075 }
00076 /*-----------------------------------------------------------------------------------*/ 
00077 
00078 
00079 
00080