c9924cc5dbfef3f8fbbd0f865cb11eb7d8c56f75
[scilab.git] / scilab / modules / randlib / sci_gateway / c / sci_grand.c
1 /*
2 * Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
3 * Copyright (C) ENPC
4 *
5 * This file must be used under the terms of the CeCILL.
6 * This source file is licensed as described in the file COPYING, which
7 * you should have received as part of this distribution.  The terms
8 * are also available at
9 * http://www.cecill.info/licences/Licence_CeCILL_V2-en.txt
10 *
11 */
12
13 /*------------------------------------------------------------------------
14 *    Interface for grand
15 *    jpc@cermics.enpc.fr
16 *    stuff to deal with several generators added
17 *         by Bruno Pincon (12/11/2001)
18 *
19 --------------------------------------------------------------------------*/
20 #include <string.h>
21 #include <math.h>
22 #include "localization.h"
23 #include "stack-c.h"
24
25 /** external functions to be called through this interface **/
26
27 #include "grand.h"
28 #include "clcg4.h"
29 #include "others_generators.h"
30 #include "sciprint.h"
31 #include "Scierror.h"
32 #include "gw_randlib.h"
33
34 enum {MT, KISS, CLCG4, CLCG2, URAND, FSULTRA};
35
36 /* the current generator : */
37 static int current_gen = MT;
38
39 /* for clcg4 : the current virtual gen (current_clcg4 in [0, Maxgen]) */
40 static int current_clcg4 = 0;
41
42 /* clcg4 must be called with the virtual generator number */
43 static unsigned long int clcg4_with_gen(void)
44 {
45     return ( clcg4(current_clcg4) );
46 }
47
48 #define NbGenInScilab 6
49
50 /*  pointers onto the generators func */
51 unsigned long int (*gen[NbGenInScilab])(void) = { randmt, kiss,  clcg4_with_gen, clcg2 , urandc , fsultra};
52
53 /*  names at the scilab level */
54 static char *names_gen[NbGenInScilab] = { "mt",  "kiss","clcg4", "clcg2", "urand", "fsultra" };
55
56 /* all the generators provided integers in [0, RngMaxInt] :        */
57 static
58 unsigned long RngMaxInt[NbGenInScilab] = { 4294967295ul,  /* mt    */
59 4294967295ul,  /* kiss  */
60 2147483646ul,  /* clcg4 */
61 2147483561ul,  /* clcg2 */
62 2147483647ul,  /* urand */
63 4294967295ul}; /* fsultra*/
64 /* the factors (1/(RngMaxInt+1)) to get reals in [0,1) :           */
65 static
66 double factor[NbGenInScilab] = { 2.3283064365386963e-10,  /* mt    */
67 2.3283064365386963e-10,  /* kiss  */
68 4.6566128752457969e-10,  /* clcg4 */
69 4.6566130595601735e-10,  /* clcg2 */
70 4.6566128730773926e-10,  /* urand */
71 2.3283064365386963e-10}; /* fsultra*/
72
73 double C2F(ranf)(void)
74 {
75     /* random deviate from U[0,1) */
76     return ( (double) gen[current_gen]() * factor[current_gen] );
77 }
78
79 double ignlgi(void)
80 {
81     /* random deviate from Ui[0,RngMaxInt] (direct output of the current gen) */
82     return ( (double) gen[current_gen]() );
83 }
84
85 double C2F(ignuin)(double *a, double *b)
86 {
87     /*  random deviate from Ui[a,b]
88     *  it is assumed that : (i)  a and b are integers (stored in double)
89     *                       (ii) b-a+1 <= RngMaxInt[current_gen]
90     *  (these verif are done at the calling level)
91     *
92     *  We use the classic method with a minor difference : to choose
93     *  uniformly an int in [a,b] (ie d=b-a+1 numbers) with a generator
94     *  which provides uniformly integers in [0,RngMaxInt] (ie m=RngMaxInt+1
95     *  numbers) we do the Euclidian division :
96     *                                           m = q d + r,   r in [0,d-1]
97     *
98     *  and accept only numbers l in [0, qd-1], then the output is k = a + (l mod d)
99     *  (ie numbers falling in [qd , RngMaxInt] are rejected).
100     *  The problem is that RngMaxInt is 2^32-1 for mt and kiss so that RngMaxInt+1 = 0
101     *  with the 32 bits unsigned int arithmetic. So in place of rejected r
102     *  numbers we reject r+1 by using RngMaxInt in place of m. The constraint is
103     *  then that (b-a+1) <= RngMaxInt and if we doesn't want to deal we each generator
104     *  we take (b-a+1) <= Min RngMaxInt =  2147483561 (clcg2)
105     */
106     unsigned long k, d = (unsigned long)((*b-*a)+1), qd;
107
108     if ( d == 1)
109         return (*a);
110
111     qd = RngMaxInt[current_gen] - RngMaxInt[current_gen] % d;
112     do
113     {
114         k = (unsigned long)ignlgi();
115     }
116     while ( k >= qd );
117     return ( *a + (double)(k % d) );
118 }
119
120 /**************************************************
121 *  hand written interface for the randlib
122 ***********************************************************************/
123
124 int sci_Rand(char *fname,unsigned long fname_len)
125 {
126     int minrhs = 1,maxrhs = 10,minlhs=1,maxlhs=2;
127     int ResL,ResC,suite,m2,n2,l2,m1,n1,l1,ls,ms,ns,la,lr,lb,lc;
128     int l3,l4;
129     int i;
130
131     Nbvars = 0;
132     CheckRhs(minrhs,maxrhs);
133     CheckLhs(minlhs,maxlhs);
134     if ( GetType(1) != sci_matrix)
135     {
136         int un=1,deux=2, dim_state_mt=625, dim_state_fsultra = 40, dim_state_4=4;
137         GetRhsVar(1,STRING_DATATYPE,&ms,&ns,&ls);
138         if ( strcmp(cstk(ls),"getsd")==0)
139         {
140             if ( Rhs != 1 )
141             {
142                 Scierror(999,_("%s: Wrong number of input argument: %d expected with option '%s'.\n"),fname,1,"getsd");
143                 return 0;
144             }
145             if ( Lhs != 1 )
146             {
147                 Scierror(999,_("%s: Wrong number of output argument: %d expected the option '%s'.\n"),fname,1,"getsd");
148                 return 0;
149             }
150
151             switch(current_gen)
152             {
153             case(MT) :
154                 CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&dim_state_mt,&un,&lr);
155                 get_state_mt(stk(lr));
156                 break;
157             case(KISS) :
158                 CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&dim_state_4,&un,&lr);
159                 get_state_kiss(stk(lr));
160                 break;
161             case(CLCG4) :
162                 CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&dim_state_4,&un,&lr);
163                 get_state_clcg4(current_clcg4, stk(lr));
164                 break;
165             case(CLCG2) :
166                 CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&deux,&un,&lr);
167                 get_state_clcg2(stk(lr));
168                 break;
169             case(URAND) :
170                 CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&un,&un,&lr);
171                 get_state_urand(stk(lr));
172                 break;
173             case(FSULTRA) :
174                 CreateVar(Rhs+2,MATRIX_OF_DOUBLE_DATATYPE,&dim_state_fsultra,&un,&lr);
175                 get_state_fsultra(stk(lr));
176                 break;
177             };
178             LhsVar(1) = Rhs+2;
179             PutLhsVar();
180             return 0;
181         }
182         else if ( strcmp(cstk(ls),"setall")==0 )
183         {
184             if ( current_gen != CLCG4 )
185                 sciprint(_("The %s option affects only the clcg4 generator\n"),"setall");
186             if ( Rhs != 5 )
187             {
188                 Scierror(999,_("%s: Wrong number of input arguments: %d expected with option '%s'.\n"),fname,5,"setall");
189                 return 0;
190             }
191             GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
192             if ( m1*n1 != 1)
193             {
194                 Scierror(999,_("%s: Wrong type input argument #%d: Scalar expected.\n"),fname, 2);
195                 return 0;
196             }
197             GetRhsVar(3,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l2);
198             if ( m1*n1 != 1)
199             {
200                 Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 3);
201                 return 0;
202             }
203             GetRhsVar(4,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l3);
204             if ( m1*n1 != 1)
205             {
206                 Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 4);
207                 return 0;
208             }
209             GetRhsVar(5,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l4);
210             if ( m1*n1 != 1)
211             {
212                 Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 5);
213                 return 0;
214             }
215
216             if (! set_initial_seed_clcg4(*stk(l1),*stk(l2), *stk(l3), *stk(l4)) )
217             {   /* => seeds were not good  (info is displayed by the function) */
218                 SciError(999);return 0;
219             }
220             LhsVar(1) = 1;
221             PutLhsVar();
222             return(0);
223         }
224         else if ( strcmp(cstk(ls),"setsd")==0 )
225         {
226             switch(current_gen)
227             {
228             case(MT) :
229                 if ( Rhs != 2 )
230                 {
231                     Scierror(999,_("%s: Wrong number of input arguments: %d expected for '%s' with the %s generator.\n"),fname,2,"setsd","mt");
232                     return 0;
233                 }
234                 GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
235                 if ( m1*n1 == 1)          /* simple init of mt     */
236                 { if (! set_state_mt_simple(*stk(l1)) ) {SciError(999); return(0);}; }
237                 else if ( m1*n1 == 625 )  /* init of all the state */
238                 { if (! set_state_mt(stk(l1))) {SciError(999); return(0);}; }
239                 else
240                 {
241                     Scierror(999,_("%s: Wrong values for input argument: Vector of %d or %d values for %s expected.\n"),fname,1, 625,"mt");
242                     return 0;
243                 };
244                 break;
245
246             case(FSULTRA) :
247                 if ( Rhs == 2 ) /* init via a "complete" state */
248                 {
249                     GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
250                     if ( m1 != 40  ||  n1 != 1)
251                     {
252                         Scierror(999,_("%s: Wrong size for input argument #%d: %dx%d expected.\n"),fname,2,40,1);
253                         return 0;
254                     };
255                     if (! set_state_fsultra(stk(l1)) )
256                     {
257                         SciError(999);
258                         return(0);}
259                     ;
260                 }
261                 else if ( Rhs == 3 ) /* init with 2 integers (like before) */
262                 {
263                     GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
264                     if ( m1*n1 != 1)
265                     {
266                         Scierror(999,_("%s: Wrong type for #%d input argument: Scalar expected.\n"),fname,2);
267                         return 0;
268                     };
269                     GetRhsVar(3,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l2);
270                     if ( m1*n1 != 1)
271                     { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 3); return 0;};
272                     if (! set_state_fsultra_simple(*stk(l1),*stk(l2)) ) {SciError(999); return(0);};
273                 }
274                 else
275                 {
276                     Scierror(999,_("%s: Wrong number of input arguments: %d or %d expected for '%s' option with the %s generator.\n"),fname,2,3,"setsd","fsultra");
277                     return 0;
278                 }
279                 break;
280
281             case(KISS) :
282             case(CLCG4) :
283                 if ( Rhs != 5 )
284                 {
285                     Scierror(999,_("%s: Wrong number of input arguments: expected %d for '%s' option with the %s or %s generator.\n"),fname,5,"setsd","kiss","clcg4");
286                     return 0;
287                 }
288                 GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
289                 if ( m1*n1 != 1)
290                 { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname,2); return 0;}
291                 GetRhsVar(3,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l2);
292                 if ( m1*n1 != 1)
293                 { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname,3); return 0;}
294                 GetRhsVar(4,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l3);
295                 if ( m1*n1 != 1)
296                 { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname,4); return 0;}
297                 GetRhsVar(5,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l4);
298                 if ( m1*n1 != 1)
299                 { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname,5); return 0;}
300                 if (current_gen == KISS)
301                 {if (! set_state_kiss(*stk(l1),*stk(l2),*stk(l3),*stk(l4))) {SciError(999); return 0;};}
302                 else
303                 {if (! set_seed_clcg4(current_clcg4,*stk(l1),*stk(l2),*stk(l3),*stk(l4)))
304                 {SciError(999); return 0;};}
305                 break;
306
307             case(CLCG2) :
308                 if ( Rhs != 3 )
309                 {
310                     Scierror(999,_("%s: Wrong number of input arguments: %d expected for '%s' option with the %s generator.\n"),fname,3,"setsd","clcg2");
311                     return 0;
312                 }
313                 GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
314                 if ( m1*n1 != 1)
315                 { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 2); return 0;};
316                 GetRhsVar(3,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l2);
317                 if ( m1*n1 != 1)
318                 { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 3); return 0;};
319                 if (! set_state_clcg2(*stk(l1),*stk(l2)))
320                 { SciError(999); return 0;};
321                 break;
322
323             case(URAND) :
324                 if ( Rhs != 2 )
325                 {
326                     Scierror(999,_("%s: Wrong number of input arguments: %d expected for '%s' option with the %s generator.\n"),fname,2,"setsd","urand");
327                     return 0;
328                 }
329                 GetRhsVar(2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1,&l1);
330                 if ( m1*n1 != 1)
331                 { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 2); return 0;};
332                 if (! set_state_urand(*stk(l1)))
333                 {SciError(999); return 0;};
334                 break;
335             };
336             LhsVar(1) = 0;
337             PutLhsVar();
338             return 0;
339         }
340         else if (strcmp("phr2sd",cstk(ls)) == 0)
341         {
342             if ( Rhs != 2 )
343             {
344                 Scierror(999,_("%s: Wrong number of input arguments: %d expected with option '%s'.\n"),fname,2,"phr2sd");
345                 return 0;
346             }
347             if ( Lhs > 1 ) 
348             {
349                 Scierror(999,_("%s: Wrong number of output argument: %d expected with option '%s'.\n"),fname,1,"phr2sd");
350
351                 return 0;
352             }
353             GetRhsVar(2,STRING_DATATYPE,&m1,&n1,&l1);
354             CreateVar(3,MATRIX_OF_INTEGER_DATATYPE,&un,&deux,&l2);
355
356             C2F(phrtsd)(cstk(l1),&m1,istk(l2),istk(l2+1),m1);
357             LhsVar(1) = 3;
358             PutLhsVar();
359             return 0;
360         }
361
362         else if (strcmp("initgn",cstk(ls))==0)
363         {
364             SeedType Where;
365             if ( current_gen != CLCG4 )
366                 sciprint(_("%s: The %s option affects only the %s generator\n"),fname,"initgn","clcg4");
367             if ( Rhs != 2)
368             {
369                 Scierror(999,_("%s: Wrong number of input arguments: %d expected with option '%s'.\n"),fname,2,"initgn");
370                 return 0;
371             }
372             GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE,&m1,&n1,&l1);
373             if ( *istk(l1) != 0 && *istk(l1)!= -1 && *istk(l1) != 1)
374             {
375                 Scierror(999,_("%s: Wrong value for input argument #%d: %d, %d or %d expected.\n"),fname, 2, -1, 0, 1);
376                 return 0;
377             }
378             Where = (SeedType) (*istk(l1) + 1);
379             init_generator_clcg4(current_clcg4, Where);
380             LhsVar(1) = 2;
381             PutLhsVar();
382             return 0;
383         }
384         else if (strcmp("setcgn",cstk(ls))==0)
385         {
386             if ( current_gen != CLCG4 )
387                 sciprint(_("The %s option affects only the %s generator\n"),"setcgn","clcg4");
388             if ( Rhs != 2)
389             {
390                 Scierror(999,_("%s: Wrong number of input arguments: %d expected with option '%s'.\n"),fname,2,"setcgn");
391                 return 0;
392             }
393             GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE,&m1,&n1,&l1);
394             if ( *istk(l1) < 0 || *istk(l1) > Maxgen )
395             {
396                 Scierror(999,_("%s: Wrong value for input argument #%d: Must be between %d and %d.\n"),fname,2, 0, Maxgen);
397                 return 0;
398             }
399             current_clcg4 = *istk(l1);
400             LhsVar(1) = 2;
401             PutLhsVar();
402             return 0;
403         }
404         else if (strcmp("advnst",cstk(ls))==0)
405         {
406             int k;
407             if ( current_gen != CLCG4 )
408                 sciprint(_("The %s option affects only the %s generator\n"),"advnst","clcg4");
409             if ( Rhs != 2)
410             {
411                 Scierror(999,_("%s: Wrong number of input arguments: %d expected with option '%s'.\n"),fname,2,"advnst");
412                 return 0;
413             }
414             GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE,&m1,&n1,&l1);
415             k = *istk(l1);
416             if ( k < 1 )
417             {
418                 Scierror(999,_("%s: Wrong value for input argument #%d: Must be > %d.\n"),fname,2,0);
419                 return 0;
420             }
421             advance_state_clcg4(current_clcg4, k);
422             LhsVar(1) = 2;
423             PutLhsVar();
424             return 0;
425         }
426         else if (strcmp("getcgn",cstk(ls))==0)
427         {
428             if ( Rhs != 1)
429             {
430                 Scierror(999,_("%s: Wrong number of input argument: %d expected with option '%s'.\n"),fname,1,"getcgn");
431                 return 0;
432             }
433             if ( current_gen != CLCG4 )
434                 sciprint(_("This information concerns only the clcg4 generator\n"));
435             CreateVar(2,MATRIX_OF_INTEGER_DATATYPE,&un,&un,&l1);
436             *istk(l1) = current_clcg4;
437             LhsVar(1) = 2;
438             PutLhsVar();
439             return 0;
440         }
441         else if (strcmp("setgen",cstk(ls))==0)
442         {
443             int msb, nsb, lsb;
444             if ( Rhs != 2)
445             {
446                 Scierror(999,_("%s: Wrong number of input arguments: %d expected with option '%s'.\n"),fname,2,"setgen");
447                 return 0;
448             }
449             GetRhsVar(2,STRING_DATATYPE,&msb,&nsb,&lsb);
450             if (strcmp("mt",cstk(lsb))==0)
451                 current_gen = MT;
452             else if (strcmp("kiss",cstk(lsb))==0)
453                 current_gen = KISS;
454             else if (strcmp("clcg4",cstk(lsb))==0)
455                 current_gen = CLCG4;
456             else if (strcmp("clcg2",cstk(lsb))==0)
457                 current_gen = CLCG2;
458             else if (strcmp("urand",cstk(lsb))==0)
459                 current_gen = URAND;
460             else if (strcmp("fsultra",cstk(lsb))==0)
461                 current_gen = FSULTRA;
462             else
463             {
464                 Scierror(999,_("%s: Wrong value for input argument #%d: '%s', '%s', '%s', '%s', '%s' or '%s' expected.\n"),fname,2, "mt","kiss","clcg4","clcg2","urand","fsultra");
465                 return 0;
466             }
467             LhsVar(1) = 2;
468             PutLhsVar();
469             return 0;
470         }
471         else if (strcmp("getgen",cstk(ls))==0)
472         {
473             int l_un=1;
474             if ( Rhs != 1)
475             {
476                 Scierror(999,_("%s: Wrong number of input argument: %d expected with option '%s'.\n"),fname,1,"getgen");
477                 return 0;
478             }
479             CreateVarFromPtr( Rhs+2,MATRIX_OF_STRING_DATATYPE, &l_un, &l_un, &names_gen[current_gen]);
480             LhsVar(1) = Rhs+2;
481             PutLhsVar();
482             return 0;
483         }
484         else
485         {
486             Scierror(999,_("%s Wrong value for input argument#%d: %s.\n"),fname,1, cstk(ls));
487
488             return 0;
489         }
490     }
491     minrhs = 2;
492     CheckRhs(minrhs,maxrhs);
493     if ( GetType(2) == sci_matrix ) /** m,n,'string' */
494     {
495         GetRhsVar(1, MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &l1);
496         if ( m1*n1 != 1)
497         { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 1);return 0;}
498         ResL= *istk(l1);
499         GetRhsVar(2,MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &l2);
500         if ( m2*n2 != 1)
501         { Scierror(999,_("%s: Wrong type for input argument #%d: Scalar expected.\n"),fname, 2);return 0;}
502         ResC= *istk(l2);
503         GetRhsVar(3,STRING_DATATYPE, &ms, &ns, &ls);
504         suite=4;
505         if (ResL < 0 && (ResL != -1 || ResC != -1)) //ResL=-1 & ResC=-1 => eye
506         {
507             Scierror(999,_("%s: Wrong value for input argument #%d: Positive scalar expected.\n"),fname, 1);
508             return 0;
509         }
510
511         if (ResC < 0 && (ResL != -1 || ResC != -1)) //ResL=-1 & ResC=-1 => eye
512         {
513             Scierror(999,_("%s: Wrong value for input argument #%d: Positive scalar expected.\n"),fname, 2);
514             return 0;
515         }
516     }
517     else
518     {
519         GetRhsVar(1,MATRIX_OF_INTEGER_DATATYPE, &ResL, &ResC, &l1);
520         GetRhsVar(2,STRING_DATATYPE, &ms, &ns, &ls);
521         suite = 3;
522     }
523     if ( strcmp(cstk(ls),"bet")==0)
524     {
525         double minlog=1.e-37;
526         if ( Rhs != suite + 1)
527         { Scierror(999,_("Missing A and B for beta law\n"));return 0;}
528         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
529         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"A");return 0;}
530         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
531         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"B");return 0;}
532         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
533         if ( *stk(la) < minlog || *stk(lb) < minlog)
534         {
535             Scierror(999,_("Rand(...,'bet',..): A or B < %f\n"),minlog);
536             return 0;
537         }
538         for ( i=0 ; i < ResL*ResC ; i++)
539         {
540             *stk(lr+i)= C2F(genbet)(stk(la),stk(lb));
541         }
542         LhsVar(1) = suite+2;
543         PutLhsVar();
544         return 0;
545     }
546     else if ( strcmp(cstk(ls),"f")==0)
547     {
548         if ( Rhs != suite + 1)
549         { Scierror(999,_("Missing Dfn and Dfd for F law\n"));return 0;}
550         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
551         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"Dfn");return 0;}
552         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
553         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"Dfd");return 0;}
554         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
555         if ( *stk(la) <= 0.0 || *stk(lb) <= 0.0)
556         {
557             Scierror(999,_("Degrees of freedom nonpositive\n"));
558             return 0;
559         }
560         for ( i=0 ; i < ResL*ResC ; i++)
561         {
562             *stk(lr+i)= C2F(genf)(stk(la),stk(lb));
563         }
564         LhsVar(1) = suite+2;
565         PutLhsVar();
566         return 0;
567     }
568     else if ( strcmp(cstk(ls),"mul")==0)
569     {
570         int l_i,nn,ncat;
571         double ptot;
572         if ( suite != 3 || ResL*ResC != 1)
573         { Scierror(999,_("%s: Wrong value for input argument #%d: Must be the number of random deviate.\n"),fname, 1);
574         return 0;
575         }
576         nn= *istk(l1);
577         if ( Rhs != suite + 1)
578         { Scierror(999,_("Missing N and P for MULtinomial law\n"));return 0;}
579         GetRhsVar(suite,MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &la);
580         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"N");return 0;}
581         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &lb);
582         if ( n2 != 1 )
583         {
584             Scierror(999,_("%s: Wrong size for input argument: Column vector expected.\n"),fname);
585             return 0;
586         }
587         ncat = m2+1;
588         CreateVar(suite+2,MATRIX_OF_INTEGER_DATATYPE,&ncat,&nn,&lr);
589         if ( *istk(la) < 0 )
590         {
591             Scierror(999,_("N < 0\n"));
592             return 0;
593         }
594         if ( ncat <= 1)
595         {
596             Scierror(999,_("Ncat <= 1\n"));
597             return 0;
598         }
599         ptot = 0.0;
600         for ( l_i= 0 ; l_i < ncat -1 ; l_i++ )
601         {
602             if ( *stk(lb+l_i) < 0.0 )
603             {
604                 Scierror(999,_("P(%d) < 0\n"),l_i+1);
605                 return 0;
606             }
607             if ( *stk(lb+l_i) > 1.0 )
608             {
609                 Scierror(999,_("P(%d) > 1\n"),l_i+1);
610                 return 0;
611             }
612             ptot += *stk(lb+l_i);
613         }
614         if ( ptot > 1.0)
615         {
616             Scierror(999,_("Sum of P(i) > 1\n"));
617             return 0;
618         }
619         for ( l_i=0 ; l_i < nn ; l_i++)
620         {
621             C2F(genmul)(istk(la),stk(lb),&ncat,istk(lr+ncat*l_i));
622         }
623         LhsVar(1) = suite+2;
624         PutLhsVar();
625         return 0;
626     }
627     else if ( strcmp(cstk(ls),"gam")==0)
628     {
629         if ( Rhs != suite + 1)
630
631             /*  ETRE PLUS CONSISTANT ICI : choisir entre shape , scale ou
632             bien A et R (idem pour le man)
633             */
634         { Scierror(999,_("Missing shape and scale for Gamma law\n"));return 0;}
635         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
636         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"shape");return 0;}
637         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
638         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"scale");return 0;}
639         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
640         if ( (*stk(la)) <= 0.0 ||  (*stk(lb)) <= 0.0 )
641         {
642             Scierror(999,_("grand(..'gam',A,R) : A <= 0.0 or R <= 0.0\n")); return 0;
643         }
644         for ( i=0 ; i < ResL*ResC ; i++)
645         {
646             /** WARNING : order is changed in parameters for
647             compatibility between Rand(...'gam',..) and cdfgam
648             **/
649             *stk(lr+i)= C2F(gengam)(stk(lb),stk(la));
650         }
651         LhsVar(1) = suite+2;
652         PutLhsVar();
653         return 0;
654     }
655
656     else if ( strcmp(cstk(ls),"nor")==0)
657     {
658         if ( Rhs != suite + 1)
659         { Scierror(999,_("Missing Av and Sd for Normal law\n"));return 0;}
660         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
661         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"Av");return 0;}
662         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
663         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong size for input argument: Scalar expected for %s.\n"),fname,"Sd");return 0;}
664         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
665         if ( *stk(lb) < 0 )
666         {
667             Scierror(999,_("SD < 0.0\n"));return 0;}
668         for ( i=0 ; i < ResL*ResC ; i++)
669         {
670             *stk(lr+i)= C2F(gennor)(stk(la),stk(lb));
671         }
672         LhsVar(1) = suite+2;
673         PutLhsVar();
674         return 0;
675     }
676     else if ( strcmp(cstk(ls),"unf")==0)
677     {
678         double low = 0, high = 0;
679         if ( Rhs != suite + 1)
680         { 
681             Scierror(999,_("Missing Low and High for Uniform Real law\n"));
682             return 0;
683         }
684
685         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
686         if ( m1*n1 != 1) 
687         { 
688             Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);
689             return 0;
690         }
691
692         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
693         if ( m1*n1 != 1) 
694         { 
695             Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);
696             return 0;
697         }
698
699         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
700         low = *stk(la);
701         high =  *stk(lb);
702         if ( low > high )
703         {
704             Scierror(999,_("%s: Wrong type for input argument. Low < High expected.\n"), fname);
705             return 0;
706         }
707         for ( i=0 ; i < ResL*ResC ; i++)
708         {
709             *stk(lr+i)= low + (high - low)* C2F(ranf)();
710         }
711         LhsVar(1) = suite+2;
712         PutLhsVar();
713         return 0;
714     }
715     else if ( strcmp(cstk(ls),"uin") == 0)
716     {
717         double a = 0, b = 0;
718         if ( Rhs != suite + 1)
719         { 
720             Scierror(999,_("Missing Low and High for Uniform int law\n"));
721             return 0;
722         }
723
724         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
725
726         if ( m1*n1 != 1) 
727         { 
728             Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);
729             return 0;
730         }
731
732         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
733         if ( m1*n1 != 1) 
734         { 
735             Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);
736             return 0;
737         }
738         a = *stk(la);
739         b = *stk(lb);
740
741         if ( a > b )
742         {
743             Scierror(999,_("%s: Wrong type for input argument. Low < High expected.\n"), fname);
744             return 0;
745         }
746
747         if ( a != floor(a) || b != floor(b) || (b-a+1) > 2147483561 )
748         {
749             Scierror(999,_("a and b must integers with (b-a+1) <= 2147483561"));
750             return 0;
751         }
752
753         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
754         for ( i=0 ; i < ResL*ResC ; i++)
755         {
756             *stk(lr+i)= C2F(ignuin)(stk(la),stk(lb));
757         }
758         LhsVar(1) = suite+2;
759         PutLhsVar();
760         return 0;
761     }
762     else if ( strcmp(cstk(ls),"lgi")==0)
763     {
764         if ( Rhs != suite -1 )
765         {
766             Scierror(999,_("%s: Wrong number of input argument: %d expected with option '%s'.\n"),fname, suite-1,"lgi");
767             return 0;
768         }
769         CreateVar(suite,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
770         for ( i=0 ; i < ResL*ResC ; i++)
771             *stk(lr+i)= ignlgi();
772         LhsVar(1) = suite;
773         PutLhsVar();
774         return 0;
775     }
776     else if ( strcmp(cstk(ls),"prm")==0)
777     {
778         int nn;
779         if ( suite != 3 || ResL*ResC != 1)
780         {
781             Scierror(999,_("%s: Wrong value for input argument: Number of random simulation expected.\n"),fname);
782             return 0;
783         }
784         nn= *istk(l1);
785         if ( Rhs != suite)
786         {
787             Scierror(999,_("Missing vect for random permutation\n"));
788             return 0;}
789         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
790         if ( n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Column vector expected.\n"),fname);
791         return 0;}
792         CreateVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE,&m1,&nn,&lr);
793         for ( i=0 ; i < nn ; i++)
794         {
795             int j ;
796             for (j=0; j < m1 ; j++ ) *stk(lr+(m1)*i+j)= *stk(la+j);
797             C2F(genprm)(stk(lr+(m1)*i),&m1);
798         }
799         LhsVar(1) = suite+1;
800         PutLhsVar();
801         return 0;
802     }
803     else if ( strcmp(cstk(ls),"nbn")==0)
804     {
805         if ( Rhs != suite + 1)
806         { Scierror(999,_("Missing N and P for Negative Binomial law\n"));return 0;}
807         GetRhsVar(suite,MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &la);
808         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
809         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
810         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
811         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
812         if ( *stk(lb) < 0.0 || *stk(lb) > 1.0 )
813         {
814             Scierror(999,_("P is not in [0,1]\n"));
815             return 0;
816         }
817         if ( *istk(la) < 0 )
818         {
819             Scierror(999,_("N < 0\n"));
820             return 0;
821         }
822         for ( i=0 ; i < ResL*ResC ; i++)
823         {
824             *stk(lr+i)= (double) C2F(ignnbn)(istk(la),stk(lb));
825         }
826         LhsVar(1) = suite+2;
827         PutLhsVar();
828         return 0;
829     }
830     else if ( strcmp(cstk(ls),"bin")==0)
831     {
832         if ( Rhs != suite + 1)
833         { Scierror(999,_("Missing N and P for Binomial law\n"));return 0;}
834         GetRhsVar(suite,MATRIX_OF_INTEGER_DATATYPE, &m1, &n1, &la);
835         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
836         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
837         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
838         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
839         if ( *stk(lb) < 0.0 || *stk(lb) > 1.0 )
840         {
841             Scierror(999,_("P is not in [0,1]\n"));
842             return 0;
843         }
844         if ( *istk(la) < 0 )
845         {
846             Scierror(999,_("N < 0\n"));
847             return 0;
848         }
849         for ( i=0 ; i < ResL*ResC ; i++)
850         {
851             *stk(lr+i)= (double) C2F(ignbin)(istk(la),stk(lb));
852         }
853         LhsVar(1) = suite+2;
854         PutLhsVar();
855         return 0;
856     }
857
858     else if ( strcmp(cstk(ls),"mn")==0)
859     {
860         int nn,un=1,work,mp,parm,ierr;
861         if ( suite != 3 || ResL*ResC != 1)
862         { Scierror(999,_("%s: Wrong value for input argument #%d: Must be the number of random simulation.\n"),fname, 1);return 0;
863         }
864         nn= *istk(l1);
865         if ( Rhs != suite + 1)
866         { Scierror(999,_("Missing Mean and Cov for Multivariate Normal law\n"));return 0;}
867         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
868         if ( n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Column vector expected.\n"),fname);return 0;}
869         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m2, &n2, &lb);
870         if ( m2 != n2 ) { Scierror(999,_("%s: Wrong type for input argument: Square matrix expected.\n"),fname);return 0;}
871         if ( m2 != m1 ) { Scierror(999,_("%s: Wrong type for input arguments: Mean and Cov have incompatible dimensions\n"),fname);return 0;}
872
873         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&m1,&nn,&lr);
874         CreateVar(suite+3,MATRIX_OF_DOUBLE_DATATYPE,&m1,&un,&work);
875         mp=m1*(m1+3)/2 + 1;
876         CreateVar(suite+4,MATRIX_OF_DOUBLE_DATATYPE,&mp,&un,&parm);
877         if ( m1 <= 0 )
878         {
879             Scierror(999,_("%s: Wrong size for input arguments: Mean and Cov are of null size.\n"),fname);
880             return 0;
881         }
882         C2F(setgmn)(stk(la),stk(lb),&m2,&m1,stk(parm),&ierr);
883         if ( ierr == 1)
884         {
885             SciError(999);return 0;
886         }
887         for ( i=0 ; i < nn ; i++)
888         {
889             C2F(genmn)(stk(parm),stk(lr+(m1)*i),stk(work));
890         }
891         LhsVar(1) = suite+2;
892         PutLhsVar();
893         return 0;
894     }
895     else if ( strcmp(cstk(ls),"markov")==0)
896     {
897         int nn,n1p1,lr1,j,icur,mm,jj;
898         if ( suite != 3 || ResL*ResC != 1)
899         { Scierror(999,_("%s: Wrong value for input argument #%d: Must be the number of random simulation.\n"),fname, 1);return 0;
900         }
901         nn= *istk(l1);
902         if ( Rhs != suite +1 )
903         { Scierror(999,_("%s: Missing P matrix and X0 for Markov chain\n"),"fname");return 0;}
904         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
905         GetRhsVar(suite+1,MATRIX_OF_INTEGER_DATATYPE, &m2, &n2, &lb);
906         if ( m1 != n1 && m1 != 1 )
907         {
908             Scierror(999,_("%s: Wrong type for input argument #%d: Square matrix or row vector expected.\n"), fname, 2);return 0;
909         }
910
911         if ( m2*n2 == 0 ) { Scierror(999,_("X0 is empty\n"));return 0;}
912
913         for ( i = 0 ; i < m2*n2 ; i++)
914             if ( *istk(lb+i)-1 < 0 || *istk(lb+i)-1 >= n1 )
915             {
916                 Scierror(999,_("%s: X0(%d) must be in the range [1,%d[\n"),fname,i+1,n1+1);
917                 return 0;
918             }
919             mm= m2*n2;
920             CreateVar(suite+2,MATRIX_OF_INTEGER_DATATYPE,&mm,&nn,&lr);
921
922             n1p1=n1+1;
923             CreateVar(suite+3,MATRIX_OF_DOUBLE_DATATYPE,&m1,&n1p1,&lr1);
924             for ( i= 0 ; i < m1 ; i++ )
925             {
926                 double ptot = 0.0;
927                 for ( j = 0 ; j < n1 ; j++ )
928                 {
929                     if ( *stk(la+i+m1*j) < 0 )
930                     {
931                         Scierror(999,_("P(%d,%d) < 0\n"),i+1,j+1);
932                         return 0;
933                     }
934                     if ( *stk(la+i+m1*j) > 1 )
935                     {
936                         Scierror(999,_("P(%d,%d) > 1\n"),i+1,j+1);
937                         return 0;
938                     }
939                     ptot += *stk(la+i+m1*j) ;
940                 }
941                 if ( fabs(ptot-1.0) > 1e-8 )
942                 {
943                     Scierror(999,_("Sum of P(%d,1:%d)=%f ~= 1\n"),i+1,n1,ptot);
944                     return 0;
945                 }
946             }
947             /** Computing the cumulative sum of the P matrix **/
948             for ( i = 0 ; i < m1 ; i++)
949             {
950                 double cumsum=0.0;
951                 *stk(lr1 +i) = cumsum;
952                 for ( j= 1; j < n1p1 ; j++ )
953                 {
954                     cumsum += *stk(la + i + m1*(j-1));
955                     *stk(lr1+i+m1*j) = cumsum;
956                 }
957             }
958             for ( jj = 0 ; jj < mm ; jj++)
959             {
960                 icur = *istk(lb+jj)-1;
961                 for ( i=0 ; i < nn ; i++)
962                 {
963                     int niv=0;
964                     double rr = C2F(ranf)();
965                     if ( m1 == 1 ) icur =0;
966                     while ( rr >= *stk(lr1+ icur +m1*niv) && niv < n1p1 )
967                     {
968                         niv++;
969                     }
970                     /** projection to avoid boundaries **/
971                     niv = Max(Min(niv,n1),1);
972                     *istk(lr+jj+mm*i)= niv ;
973                     icur=niv-1;
974                 }
975             }
976             LhsVar(1) = suite+2;
977             PutLhsVar();
978             return 0;
979     }
980     else if ( strcmp(cstk(ls),"def")==0)
981     {
982         if ( Rhs != suite -1 )
983         { Scierror(999,_("%s: Wrong number of input argument.\n"),fname);return 0;}
984         CreateVar(suite,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
985         for ( i=0 ; i < ResL*ResC ; i++)
986         {
987             *stk(lr+i)= C2F(ranf)();
988         }
989         LhsVar(1) = suite;
990         PutLhsVar();
991         return 0;
992     }
993
994     else if ( strcmp(cstk(ls),"nch")==0)
995     {
996         if ( Rhs != suite + 1)
997         { Scierror(999,_("Missing Df and Xnonc for non-central chi-square law\n"));return 0;}
998         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
999         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1000         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
1001         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1002         CreateVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
1003         if ( *stk(la) < 1.0 || *stk(lb) < 0.0 )
1004         {
1005             Scierror(999,_("DF < 1 or XNONC < 0\n"));
1006             return 0;
1007         }
1008         for ( i=0 ; i < ResL*ResC ; i++)
1009         {
1010             *stk(lr+i)= C2F(gennch)(stk(la),stk(lb));
1011         }
1012         LhsVar(1) = suite+2;
1013         PutLhsVar();
1014         return 0;
1015     }
1016     else if ( strcmp(cstk(ls),"nf")==0)
1017     {
1018         if ( Rhs != suite + 2)
1019         {
1020             Scierror(999,_("Missing Dfn, Dfd and Xnonc for non-central F law\n"));
1021             return 0;}
1022         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
1023         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1024         GetRhsVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lb);
1025         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1026         GetRhsVar(suite+2,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &lc);
1027         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1028         CreateVar(suite+3,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
1029         if ( *stk(la) < 1.0 || *stk(lb) < 0.0 || *stk(lc) < 0.0 )
1030         {
1031             Scierror(999,_("DF < 1.0 or DF <= 0.0 or Xnonc < 0.0\n"));
1032             return 0;
1033         }
1034         for ( i=0 ; i < ResL*ResC ; i++)
1035         {
1036             *stk(lr+i)= C2F(gennf)(stk(la),stk(lb),stk(lc));
1037         }
1038         LhsVar(1) = suite+3;
1039         PutLhsVar();
1040         return 0;
1041     }
1042
1043     else if ( strcmp(cstk(ls),"chi")==0)
1044     {
1045         if ( Rhs != suite )
1046         { Scierror(999,_("Missing Df for chi-square law\n"));
1047         return 0;
1048         }
1049         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
1050         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1051         CreateVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
1052         if  ( *stk(la) <= 0.0)
1053         {
1054             Scierror(999,_("Rand: DF <= 0\n"));return 0;
1055         }
1056         for ( i=0 ; i < ResL*ResC ; i++)
1057         {
1058             *stk(lr+i)= C2F(genchi)(stk(la));
1059         }
1060         LhsVar(1) = suite+1;
1061         PutLhsVar();
1062         return 0;
1063     }
1064     else if ( strcmp(cstk(ls),"poi")==0)
1065     {
1066         if ( Rhs != suite )
1067         { Scierror(999,_("Missing Av for Poisson law\n"));
1068         return 0;}
1069         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
1070         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1071         CreateVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
1072         if ( *stk(la) < 0.0 )
1073         {
1074             Scierror(999,_("Av < 0\n"));
1075             return 0;
1076         }
1077         for ( i=0 ; i < ResL*ResC ; i++)
1078         {
1079             *stk(lr+i)= (double) C2F(ignpoi)(stk(la));
1080         }
1081         LhsVar(1) = suite+1;
1082         PutLhsVar();
1083         return 0;
1084     }
1085     else if ( strcmp(cstk(ls),"geom")==0)
1086     {
1087         double p;
1088         if ( Rhs != suite )
1089         { Scierror(999,_("Missing p for Geometric law\n"));
1090         return 0;}
1091         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
1092         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1093         p = *stk(la);
1094         if ( p < 1.3e-307 || p > 1 ) { Scierror(999,_("%s: Wrong value for input argument: Must be between '%s' and %d.\n"),fname,"pmin",1);return 0;}
1095
1096         CreateVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
1097         for ( i=0 ; i < ResL*ResC ; i++)
1098         {
1099             *stk(lr+i)= igngeom(p);
1100         }
1101         LhsVar(1) = suite+1;
1102         PutLhsVar();
1103         return 0;
1104     }
1105
1106     else if ( strcmp(cstk(ls),"exp")==0)
1107     {
1108         if ( Rhs != suite )
1109         { Scierror(999,_("Missing Av for exponential law\n"));
1110         return 0;}
1111         GetRhsVar(suite,MATRIX_OF_DOUBLE_DATATYPE, &m1, &n1, &la);
1112         if ( m1*n1 != 1) { Scierror(999,_("%s: Wrong type for input argument: Scalar expected.\n"),fname);return 0;}
1113         CreateVar(suite+1,MATRIX_OF_DOUBLE_DATATYPE,&ResL,&ResC,&lr);
1114         if ( *stk(la) < 0.0 )
1115         {
1116             Scierror(999,_("Av < 0.0\n"));
1117             return 0;
1118         }
1119         for ( i=0 ; i < ResL*ResC ; i++)
1120         {
1121             *stk(lr+i)= C2F(genexp)(stk(la));
1122         }
1123         LhsVar(1) = suite+1;
1124         PutLhsVar();
1125         return 0;
1126     }
1127
1128     else
1129     {
1130         Scierror(999,_("%s: Wrong value for input argument %s.\n"),fname,cstk(ls));
1131         return 0;
1132     }
1133 }