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