0022786: 64bit issue in AdvApp2Var
[occt.git] / src / AdvApp2Var / AdvApp2Var_SysBase.cxx
1 // Copyright (c) 1999-2012 OPEN CASCADE SAS
2 //
3 // The content of this file is subject to the Open CASCADE Technology Public
4 // License Version 6.5 (the "License"). You may not use the content of this file
5 // except in compliance with the License. Please obtain a copy of the License
6 // at http://www.opencascade.org and read it completely before using this file.
7 //
8 // The Initial Developer of the Original Code is Open CASCADE S.A.S., having its
9 // main offices at: 1, place des Freres Montgolfier, 78280 Guyancourt, France.
10 //
11 // The Original Code and all software distributed under the License is
12 // distributed on an "AS IS" basis, without warranty of any kind, and the
13 // Initial Developer hereby disclaims all such warranties, including without
14 // limitation, any warranties of merchantability, fitness for a particular
15 // purpose or non-infringement. Please see the License for the specific terms
16 // and conditions governing the rights and limitations under the License.
17
18 // AdvApp2Var_SysBase.cxx
19 #include <math.h>
20 #include <stdlib.h>
21 #include <string.h>
22 #include <AdvApp2Var_Data_f2c.hxx>
23 #include <AdvApp2Var_SysBase.hxx>
24 #include <AdvApp2Var_Data.hxx>
25 #include <Standard.hxx>
26
27
28 static 
29 int __i__len();
30
31 static
32 int __s__cmp();
33
34 static
35 int macrbrk_();
36
37 static
38 int macrchk_();
39
40 static
41 int macrclw_(intptr_t *iadfld, 
42              intptr_t *iadflf, 
43              integer *nalloc);
44 static
45 int macrerr_(intptr_t *iad,
46              intptr_t *nalloc);
47 static
48 int macrgfl_(intptr_t *iadfld, 
49              intptr_t *iadflf, 
50              integer  *iphase, 
51              integer  *iznuti);
52 static
53 int macrmsg_(const char *crout, 
54              integer *num, 
55              integer *it, 
56              doublereal *xt, 
57              const char *ct, 
58              ftnlen crout_len,
59              ftnlen ct_len);
60
61 static
62 int macrstw_(intptr_t *iadfld, 
63              intptr_t *iadflf, 
64              integer *nalloc);
65
66 static
67 int madbtbk_(integer *indice);
68
69 static
70 int magtlog_(const char *cnmlog, 
71              const char *chaine, 
72              integer *long__, 
73              integer *iercod, 
74              ftnlen cnmlog_len, 
75              ftnlen chaine_len);
76
77
78 static
79 int mamdlng_(char *cmdlng, 
80              ftnlen cmdlng_len);
81
82 static
83 int maostrb_();
84
85 static
86 int maostrd_();
87
88 static
89 int maoverf_(integer *nbentr, 
90              doublereal *dtable);
91
92 static
93 int matrlog_(const char *cnmlog, 
94              const char *chaine, 
95              integer *length, 
96              integer *iercod, 
97              ftnlen cnmlog_len, 
98              ftnlen chaine_len);
99
100 static
101 int matrsym_(const char *cnmsym, 
102              const char *chaine, 
103              integer *length, 
104              integer *iercod, 
105              ftnlen cnmsym_len, 
106              ftnlen chaine_len);
107
108 static
109 int mcrcomm_(integer *kop, 
110              integer *noct, 
111              intptr_t *iadr, 
112              integer *ier);
113
114 static
115 int mcrfree_(integer *ibyte,
116              void* *iadr,
117              integer *ier);
118
119 static
120 int mcrgetv_(integer *sz,
121              void* *iad,
122              integer *ier);
123
124 static
125 int mcrlist_(integer *ier);
126
127 static
128 int mcrlocv_(void* t,
129              intptr_t *l);
130
131
132 /* Structures */
133 static struct {
134     intptr_t icore[12000];      
135     integer ncore, lprot;
136 } mcrgene_;
137
138 static struct {
139     integer nrqst[2], ndelt[2], nbyte[2], mbyte[2];
140 } mcrstac_;
141
142 static struct {
143     integer lec, imp, keyb, mae, jscrn, itblt, ibb;
144 } mblank__;
145
146 #define mcrfill_ABS(a)  (((a)<0)?(-(a)):(a)) 
147
148
149 //=======================================================================
150 //function : macinit_
151 //purpose  : 
152 //=======================================================================
153 int AdvApp2Var_SysBase::macinit_(integer *imode, 
154                                  integer *ival)
155
156 {
157  
158   /* Fortran I/O blocks */
159   static cilist io______1 = { 0, 0, 0, (char*) "(' --- Debug-mode : ',I10,' ---')", 0 };
160   
161   /* ************************************************************************/
162   /*     FUNCTION : */
163   /*     ---------- */
164   /*   INITIALIZATION OF READING WRITING UNITS AND 'IBB' */
165   
166   /*     KEYWORDS : */
167   /*     ----------- */
168   /*   MANAGEMENT, CONFIGURATION, UNITS, INITIALIZATION */
169   
170   /*     INPUT ARGUMENTS  : */
171   /*     -------------------- */
172   /*        IMODE : MODE of INITIALIZATION : 
173             0= DEFAULT, IMP IS 6, IBB 0 and LEC 5 */
174   /*        1= FORCE VALUE OF IMP */
175   /*        2= FORCE VALUE OF IBB */
176   /*        3= FORCE VALUE OF LEC */
177   
178   /*    ARGUMENT USED ONLY WHEN IMODE IS 1 OR 2 : */
179   /*       IVAL : VALUE OF IMP WHEN IMODE IS 1 */
180   /*              VALUE OF IBB WHEN IMODE IS 2 */
181   /*              VALUE OF LEC WHEN IMODE IS 3 */
182   /*    THERE IS NO CONTROL OF VALIDITY OF VALUE OF IVAL . */
183   
184   /*     OUTPUT ARGUMENTS  : */
185   /*     -------------------- */
186   /*                NONE */
187   
188   /*     COMMONS USED : */
189   /*     -------------- */
190   /*     REFERENCES CALLED : */
191   /*     ------------------- */
192   /*     DESCRIPTION/NOTES/LIMITATIONS : */
193   /*     ------------------------------- */
194   
195   /*     THIS IS ONLY INITIALIZATION OF THE COMMON BLANK FOR ALL */
196   /*     MODULES THAT A PRIORI DO NOT NEED TO KNOW THE COMMONS OF T . */
197   /*     WHEN A MODIFICATION OF IBB IS REQUIRED (IMODE=2) AN INFO MESSAGE */
198   /*     IS SUBMITTED ON IMP, WITH THE NEW VALUE OF IBB. */
199   
200   /*       IBB : MODE DEBUG OF STRIM T : RULES OF USE : */
201   /*             0 RESTRAINED VERSION  */
202   /*             >0 THE GREATER IS IBB THE MORE COMMENTS THE VERSION HAS. */
203   /*                FOR EXAMPLE FOR IBB=1 THE ROUTINES CALLED */
204   /*                INFORM ON IMP ('INPUT IN TOTO', */
205   /*                AND 'OUTPUT FROM TOTO'), AND THE ROUTINES THAT RETURN */
206   /*                NON NULL ERROR CODE INFORM IT AS WELL. */
207   /*            (BUT IT IS NOT TRUE FOR ALL ROUTINES OF T) */
208   /* > */
209   /* ***********************************************************************
210    */
211
212   if (*imode == 0) {
213     mblank__.imp = 6;
214     mblank__.ibb = 0;
215     mblank__.lec = 5;
216   } else if (*imode == 1) {
217     mblank__.imp = *ival;
218   } else if (*imode == 2) {
219     mblank__.ibb = *ival;
220     io______1.ciunit = mblank__.imp;
221     /*
222     s__wsfe(&io______1);
223     */
224     /*
225     do__fio(&c____1, (char *)&mblank__.ibb, (ftnlen)sizeof(integer));
226     */
227     AdvApp2Var_SysBase::e__wsfe();
228   } else if (*imode == 3) {
229     mblank__.lec = *ival;
230   }
231
232   /* ----------------------------------------------------------------------*
233    */
234   
235   return 0;
236 } /* macinit__ */
237
238 //=======================================================================
239 //function : macrai4_
240 //purpose  : 
241 //=======================================================================
242 int AdvApp2Var_SysBase::macrai4_(integer *nbelem, 
243                                  integer *maxelm, 
244                                  integer *itablo,
245                                  intptr_t *iofset,
246                                  integer *iercod)
247
248 {
249   
250   /* ***********************************************************************
251    */
252   
253   /*     FUNCTION : */
254   /*     ---------- */
255   /*       Require dynamic allocation of type INTEGER */
256   
257   /*     KEYWORDS : */
258   /*     ---------- */
259   /*       SYSTEM, ALLOCATION, MEMORY, REALISATION */
260   
261   /*     INPUT ARGUMENTS : */
262   /*     ----------------- */
263   /*       NBELEM : Number of required units */
264   /*       MAXELM : Max number of units available in ITABLO */
265   /*       ITABLO : Reference Address of the rented zone */
266   
267   /*     OUTPUT ARGUMENTS : */
268   /*     ------------------- */
269   /*       IOFSET : Offset */
270   /*       IERCOD : Error code */
271   /*               = 0 : OK */
272   /*               = 1 : Max nb of allocations attained */
273   /*               = 2 : Incorrect arguments */
274   /*               = 3 : Refused dynamic allocation */
275   
276   /*     COMMONS USED : */
277   /*     ------------------ */
278   
279   /*     REFERENCES CALLED : */
280   /*     --------------------- */
281   /*        MCRRQST */
282   
283   /*     DESCRIPTION/NOTES/LIMITATIONS : */
284   /*     ----------------------------------- */
285   /*     (Cf description in the heading of MCRRQST) */
286   
287   /*     Table ITABLO should be dimensioned to MAXELM by the caller. */
288   /*     If the request is lower or equal to MAXELM, IOFSET becomes = 0.    */
289   /*     Otherwise the demand of allocation is valid and IOFSET > 0. */
290    /* > */
291   /* ***********************************************************************
292    */
293   
294   integer  iunit; 
295   /* Parameter adjustments */
296   --itablo;
297   
298   
299   iunit = sizeof(integer);    
300   /* Function Body */
301   if (*nbelem > *maxelm) {
302     AdvApp2Var_SysBase::mcrrqst_(&iunit, nbelem, &itablo[1], iofset, iercod);
303   } else {
304     *iercod = 0;
305     *iofset = 0;
306   }
307   return 0 ;
308 } /* macrai4_ */
309
310 //=======================================================================
311 //function : AdvApp2Var_SysBase::macrar8_
312 //purpose  : 
313 //=======================================================================
314 int AdvApp2Var_SysBase::macrar8_(integer *nbelem, 
315                                  integer *maxelm,
316                                  doublereal *xtablo, 
317                                  intptr_t *iofset, 
318                                  integer *iercod)
319
320 {
321   static integer c__8 = 8;
322
323   /* ***********************************************************************
324    */
325   
326   /*     FUNCTION : */
327   /*     ---------- */
328   /*       Demand of dynamic allocation of type DOUBLE PRECISION */
329   
330   /*     KEYWORDS : */
331   /*     ----------- */
332   /*       SYSTEM, ALLOCATION, MEMORY, REALISATION */
333   
334   /*     INPUT ARGUMENTS  : */
335   /*     ------------------ */
336   /*       NBELEM : Nb of units required */
337   /*       MAXELM : Max Nb of units available in XTABLO */
338   /*       XTABLO : Reference address of the rented zone */
339   
340   /*     OUTPUT ARGUMENTS : */
341   /*     ------------------ */
342   /*       IOFSET : Offset */
343   /*       IERCOD : Error code */
344   /*               = 0 : OK */
345   /*               = 1 : Max Nb of allocations reached */
346   /*               = 2 : Arguments incorrect */
347   /*               = 3 : Refuse of dynamic allocation */
348   
349   /*     COMMONS USED : */
350   /*     ------------------ */
351   
352   /*     REFERENCES CALLED : */
353   /*     --------------------- */
354   /*        MCRRQST */
355   
356   /*     DESCRIPTION/NOTES/LIMITATIONS : */
357   /*     ----------------------------------- */
358   /*     (Cf description in the heading of MCRRQST) */
359   
360   /*     Table XTABLO should be dimensioned to MAXELM by the caller. */
361   /*     If the request is less or equal to MAXELM, IOFSET becomes = 0.    */
362   /*     Otherwise the demand of allocation is valid and IOFSET > 0. */
363
364   /* > */
365   /* ***********************************************************************
366    */
367   
368   
369   /* Parameter adjustments */
370   --xtablo;
371   
372   /* Function Body */
373   if (*nbelem > *maxelm) {
374     AdvApp2Var_SysBase::mcrrqst_(&c__8, nbelem, &xtablo[1], iofset, iercod);
375   } else {
376     *iercod = 0;
377     *iofset = 0;
378   }
379   return 0 ;
380 } /* macrar8_ */
381
382 //=======================================================================
383 //function : macrbrk_
384 //purpose  : 
385 //=======================================================================
386 int macrbrk_()
387 {
388   return 0 ;
389 } /* macrbrk_ */
390
391 //=======================================================================
392 //function : macrchk_
393 //purpose  : 
394 //=======================================================================
395 int macrchk_()
396 {
397   /* System generated locals */
398   integer i__1;
399   
400   /* Local variables */
401   static integer  i__, j;
402   static intptr_t ioff;
403   static doublereal t[1];
404   static intptr_t loc;
405   
406 /* ***********************************************************************
407  */
408
409 /*     FUNCTION : */
410 /*     ---------- */
411 /*       CONTROL OF EXCESSES OF ALLOCATED MEMORY ZONE */
412
413 /*     KEYWORDS : */
414 /*     ----------- */
415 /*       SYSTEM, ALLOCATION, MEMORY, CONTROL, EXCESS */
416
417 /*     INPUT ARGUMENTS : */
418 /*     ----------------- */
419 /*       NONE */
420
421 /*     OUTPUT ARGUMENTS  : */
422 /*     ------------------- */
423 /*       NONE */
424
425 /*     COMMONS USED : */
426 /*     ------------------ */
427 /*       MCRGENE */
428
429 /*     REFERENCES CALLED : */
430 /*     --------------------- */
431 /*       MACRERR, MAOSTRD */
432
433 /*     DESCRIPTION/NOTES/LIMITATIONS : */
434 /*     ----------------------------------- */
435
436 /* > */
437 /* ***********************************************************************
438  */
439
440 /* ***********************************************************************
441  */
442
443 /*     FONCTION : */
444 /*     ---------- */
445 /*        TABLE OF MANAGEMENT OF DYNAMIC MEMOTY ALLOCATIONS */
446
447 /*     KEYWORDS : */
448 /*     ----------- */
449 /*        SYSTEM, MEMORY, ALLOCATION */
450
451 /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
452 /*     ----------------------------------- */
453
454
455 /* > */
456 /* ***********************************************************************
457  */
458
459 /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
460 /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
461 /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
462 /*         2 : UNIT OF ALLOCATION */
463 /*         3 : NB OF ALLOCATED UNITS */
464 /*         4 : REFERENCE ADDRESS OF THE TABLE */
465 /*         5 : IOFSET */
466 /*         6 : STATIC ALLOCATION NUMBER */
467 /*         7 : Required allocation size */
468 /*         8 : address of the beginning of allocation */
469 /*         9 : Size of the USER ZONE */
470 /*        10 : ADDRESS of the START FLAG */
471 /*        11 : ADDRESS of the END FLAG */
472 /*        12 : Rank of creation of the allocation */
473
474 /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
475 /*   NCORE : NB OF CURRENT ALLOCS */
476 /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
477 /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */
478
479
480
481 /* ----------------------------------------------------------------------*
482  */
483
484
485 /* ----------------------------------------------------------------------*
486  */
487
488 /* CALCULATE ADDRESS OF T */
489   mcrlocv_(t, &loc);  
490   /* CONTROL OF FLAGS IN THE TABLE */
491   i__1 = mcrgene_.ncore;
492   for (i__ = 1; i__ <= i__1; ++i__) {
493     
494     for (j = 10; j <= 11; ++j) {
495       
496       if (mcrgene_.icore[j + i__ * 12 - 13] != -1) {
497         
498         ioff = (mcrgene_.icore[j + i__ * 12 - 13] - loc) / 8;
499         
500         if (t[ioff] != -134744073.) {
501           
502           /* MSG : '*** ERREUR  : REMOVAL FROM MEMORY OF ADDRESS
503              E:',ICORE(J,I) */
504           /*       AND OF RANK ICORE(12,I) */
505           macrerr_(&mcrgene_.icore[j + i__ * 12 - 13], 
506                    &mcrgene_.icore[i__ * 12 - 1]);          
507           
508           /* BACK-PARCING IN PHASE OF PRODUCTION */
509           maostrb_();
510           
511           /* REMOVAL OF THE ADDRESS OF FLAG TO AVOID REMAKING ITS CONTROL */
512           mcrgene_.icore[j + i__ * 12 - 13] = -1;
513           
514         }
515         
516       }
517       
518       /* L100: */
519     }
520     
521     /* L1000: */
522   }
523   return 0 ;
524 } /* macrchk_ */
525
526 //=======================================================================
527 //function : macrclw_
528 //purpose  : 
529 //=======================================================================
530 int macrclw_(intptr_t *,//iadfld, 
531              intptr_t *,//iadflf, 
532              integer  *)//nalloc)
533
534 {
535   return 0 ;
536 } /* macrclw_ */
537
538 //=======================================================================
539 //function : AdvApp2Var_SysBase::macrdi4_
540 //purpose  : 
541 //=======================================================================
542 int AdvApp2Var_SysBase::macrdi4_(integer *nbelem, 
543                                  integer *,//maxelm, 
544                                  integer *itablo, 
545                                  intptr_t *iofset, /* Offset long (pmn) */
546                                  integer *iercod)
547
548 {
549   
550   /* ***********************************************************************
551  */
552
553 /*     FuNCTION : */
554 /*     ---------- */
555 /*       Destruction of dynamic allocation of type INTEGER */
556
557 /*     KEYWORDS : */
558 /*     ----------- */
559 /*       SYSTEM, ALLOCATION, MEMORY, DESTRUCTION */
560
561 /*     INPUT ARGUMENTS  : */
562 /*     ------------------ */
563 /*       NBELEM : Nb of units required */
564 /*       MAXELM : Max Nb of units available in ITABLO */
565 /*       ITABLO : Reference Address of the allocated zone */
566 /*       IOFSET : Offset */
567
568 /*     OUTPUT ARGUMENTS : */
569 /*     --------------------- */
570 /*       IERCOD : Error Code */
571 /*               = 0 : OK */
572 /*               = 1 : Pb of de-allocation of a zone allocated in table */
573 /*               = 2 : The system refuses the demand of de-allocation */
574
575 /*     COMMONS USED : */
576 /*     ------------------ */
577
578 /*     REFERENCES CALLED : */
579 /*     --------------------- */
580 /*        MCRDELT */
581
582 /*     DESCRIPTION/NOTES/LIMITATIONS : */
583 /*     ----------------------------------- */
584 /*     (Cf description in the heading of MCRDELT) */
585 /* > */
586 /* ***********************************************************************
587  */
588   integer iunit;
589   
590   /* Parameter adjustments */
591   --itablo;
592   iunit = sizeof(integer); 
593   /* Function Body */
594   if (*iofset != 0) {
595     AdvApp2Var_SysBase::mcrdelt_(&iunit, 
596                                  nbelem, 
597                                  &itablo[1], 
598                                  iofset, 
599                                  iercod);
600   } else {
601     *iercod = 0;
602   }
603   return 0 ;
604 } /* macrdi4_ */
605
606 //=======================================================================
607 //function : AdvApp2Var_SysBase::macrdr8_
608 //purpose  : 
609 //=======================================================================
610 int AdvApp2Var_SysBase::macrdr8_(integer *nbelem,
611                                  integer *,//maxelm, 
612                                  doublereal *xtablo, 
613                                  intptr_t *iofset, 
614                                  integer *iercod)
615
616 {
617   static integer c__8 = 8;
618
619 /* ***********************************************************************
620  */
621
622 /*     FUNCTION : */
623 /*     ---------- */
624 /*       Destruction of dynamic allocation of type DOUBLE PRECISION 
625 */
626
627 /*     KEYWORDS : */
628 /*     ----------- */
629 /*       SYSTEM, ALLOCATION, MEMORY, DESTRUCTION */
630
631 /*     INPUT ARGUMENTS : */
632 /*     -------------------- */
633 /*       NBELEM : Nb of units required */
634 /*       MAXELM : Max nb of units available in XTABLO */
635 /*       XTABLO : Reference Address of the allocated zone */
636 /*       IOFSET : Offset */
637
638 /*     OUTPUT ARGUMENTS  : */
639 /*     ------------------- */
640 /*       IERCOD : Error Code */
641 /*               = 0 : OK */
642 /*               = 1 : Pb of de-allocation of a zone allocated on table */
643 /*               = 2 : The system refuses the demand of de-allocation */
644
645 /*     COMMONS USED : */
646 /*     -------------- */
647
648 /*     REFERENCES CALLEDS : */
649 /*     -------------------- */
650 /*        MCRDELT */
651
652 /*     DESCRIPTION/NOTES/LIMITATIONS : */
653 /*     ----------------------------------- */
654 /*     (Cf description in the heading of MCRDELT) */
655
656 /* > */
657 /* ***********************************************************************
658  */
659   
660   
661   /* Parameter adjustments */
662   --xtablo;
663   
664   /* Function Body */
665   if (*iofset != 0) {
666     AdvApp2Var_SysBase::mcrdelt_(&c__8, nbelem, &xtablo[1], iofset, iercod);
667   } else {
668     *iercod = 0;
669   }
670   return 0 ;
671 } /* macrdr8_ */
672
673 //=======================================================================
674 //function : macrerr_
675 //purpose  : 
676 //=======================================================================
677 int macrerr_(intptr_t *,//iad,
678              intptr_t *)//nalloc)
679
680 {
681   //static integer c__1 = 1;
682   /* Builtin functions */
683   //integer /*s__wsfe(),*/ /*do__fio(),*/ e__wsfe();
684   
685   /* Fortran I/O blocks */
686   //static cilist io___1 = { 0, 6, 0, "(X,A,I9,A,I3)", 0 };
687
688 /* ***********************************************************************
689  */
690
691 /*     FUNCTION : */
692 /*     ---------- */
693 /*       WRITING OF ADDRESS REMOVED IN ALLOCS . */
694
695 /*     KEYWORDS : */
696 /*     ----------- */
697 /*       ALLOC CONTROL */
698
699 /*     INPUT ARGUMENTS  : */
700 /*     ------------------ */
701 /*       IAD    : ADDRESS TO INFORM OF REMOVAL */
702 /*       NALLOC : NUMBER OF ALLOCATION */
703
704 /*     OUTPUT ARGUMENTS : */
705 /*     --------------------- */
706 /*       NONE */
707
708 /*     COMMONS USED : */
709 /*     -------------- */
710
711 /*     REFERENCES CALLED : */
712 /*     ------------------- */
713
714 /*     DESCRIPTION/NOTES/LIMITATIONS : */
715 /*     ----------------------------------- */
716 /* > */
717 /* ***********************************************************************
718  */
719   /*
720   s__wsfe(&io___1);
721   */
722   /*
723   do__fio(&c__1, "*** ERREUR : Ecrasement de la memoire d'adresse ", 48L);
724   do__fio(&c__1, (char *)&(*iad), (ftnlen)sizeof(long int));
725   do__fio(&c__1, " sur l'allocation ", 18L);
726   do__fio(&c__1, (char *)&(*nalloc), (ftnlen)sizeof(integer));
727   */
728   AdvApp2Var_SysBase::e__wsfe();
729   
730   return 0 ;
731 } /* macrerr_ */
732
733
734 //=======================================================================
735 //function : macrgfl_
736 //purpose  : 
737 //=======================================================================
738 int macrgfl_(intptr_t *iadfld, 
739              intptr_t *iadflf, 
740              integer  *iphase, 
741              integer  *iznuti)
742
743 {
744   /* Initialized data */
745   
746   static integer ifois = 0;
747   
748   static char cbid[1];
749   static integer ibid, ienr;
750   static doublereal t[1];
751   static integer novfl;
752   static intptr_t ioff,iadrfl, iadt;
753   
754   
755   /* ***********************************************************************
756    */
757   
758   /*     FUNCTION : */
759   /*     ---------- */
760   /*       IMPLEMENTATION OF TWO FLAGS START AND END OF THE ALLOCATED ZONE */
761   /*       AND SETTING TO OVERFLOW OF THE USER SPACE IN PHASE OF PRODUCTION. */
762   
763   /*     KEYWORDS : */
764   /*     ----------- */
765   /*       ALLOCATION, CONTROL, EXCESS */
766   
767   /*     INPUT ARGUMENTS  : */
768   /*     ------------------ */
769   /*       IADFLD : ADDRESS OF THE START FLAG */
770   /*       IADFLF : ADDRESS OF THE END FLAG */
771   /*       IPHASE : TYPE OF SOFTWARE VERSION : */
772   /*                0 = OFFICIAL VERSION  */
773   /*                1 = PRODUCTION VERSION */
774   /*       IZNUTI : SIZE OF THE USER ZONE IN OCTETS */
775   
776   /*     OUTPUT ARGUMENTS : */
777   /*     ------------------ */
778   /*       NONE */
779   
780   /*     COMMONS USED : */
781   /*     ------------------ */
782   
783   /*     REFERENCES CALLED : */
784   /*     ------------------- */
785   /*       CRLOCT,MACRCHK */
786   
787   /*     DESCRIPTION/NOTES/LIMITATIONS : */
788   /*     ------------------------------- */
789
790   /* > */
791   /* ***********************************************************************
792    */
793   
794  
795
796   /* ***********************************************************************
797    */
798   
799   /*     FUNCTION : */
800   /*     ---------- */
801   /*        TABLE FOR MANAGEMENT OF DYNAMIC ALLOCATIONS OF MEMORY */
802   
803   /*     KEYWORDS : */
804   /*     ----------- */
805   /*        SYSTEM, MEMORY, ALLOCATION */
806   
807   /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
808   /*     ----------------------------------- */
809   
810
811   /* > */
812   /* ***********************************************************************
813    */
814   /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
815 /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
816 /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
817 /*         2 : UNIT OF ALLOCATION */
818 /*         3 : NB OF ALLOCATED UNITS */
819 /*         4 : REFERENCE ADDRESS OF THE TABLE */
820 /*         5 : IOFSET */
821 /*         6 : STATIC ALLOCATION NUMBER */
822 /*         7 : Required allocation size */
823 /*         8 : address of the beginning of allocation */
824 /*         9 : Size of the USER ZONE */
825 /*        10 : ADDRESS of the START FLAG */
826 /*        11 : ADDRESS of the END FLAG */
827 /*        12 : Rank of creation of the allocation */
828
829 /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
830 /*   NCORE : NB OF CURRENT ALLOCS */
831 /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
832 /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */
833
834
835   
836   
837
838   /* ----------------------------------------------------------------------*
839    */
840   
841
842   if (ifois == 0) {
843     matrsym_("NO_OVERFLOW", cbid, &novfl, &ibid, 11L, 1L);
844     ifois = 1;
845   }
846   
847   /*  CALCULATE THE ADDRESS OF T */
848   mcrlocv_(t, &iadt);
849   
850   /* CALCULATE THE OFFSET */
851   ioff = (*iadfld - iadt) / 8;
852   
853   /*  SET TO OVERFLOW OF THE USER ZONE IN CASE OF PRODUCTION VERSION */
854   if (*iphase == 1 && novfl == 0) {
855     ienr = *iznuti / 8;
856     maoverf_(&ienr, &t[ioff + 1]);
857   }
858     
859   /*  UPDATE THE START FLAG */
860   t[ioff] = -134744073.;
861   
862   /*  FAKE CALL TO STOP THE DEBUGGER : */
863   iadrfl = *iadfld;
864   macrbrk_();
865   
866   /*  UPDATE THE START FLAG */
867   ioff = (*iadflf - iadt) / 8;
868   t[ioff] = -134744073.;
869     
870   /*  FAKE CALL TO STOP THE DEBUGGER : */
871   iadrfl = *iadflf;
872   macrbrk_();
873   
874   return 0 ;
875 } /* macrgfl_ */
876
877 //=======================================================================
878 //function : macrmsg_
879 //purpose  : 
880 //=======================================================================
881 int macrmsg_(const char *,//crout, 
882              integer *,//num, 
883              integer *it, 
884              doublereal *xt, 
885              const char *ct, 
886              ftnlen ,//crout_len,
887              ftnlen ct_len)
888
889 {
890   
891   /* Local variables */
892   static integer inum, iunite;
893   static char cfm[80], cln[3];
894   
895   /* Fortran I/O blocks */
896   static cilist io___5 = { 0, 0, 0, cfm, 0 };
897   static cilist io___6 = { 0, 0, 0, cfm, 0 };
898   static cilist io___7 = { 0, 0, 0, cfm, 0 };
899  
900
901 /* ***********************************************************************
902  */
903
904 /*     FUNCTION : */
905 /*     ---------- */
906 /*        MESSAGING OF ROUTINES OF ALLOCATION */
907
908 /*     KEYWORDS : */
909 /*     ----------- */
910 /*       ALLOC, MESSAGE */
911
912 /*     INPUT ARGUMENTSEE : */
913 /*     ------------------- */
914 /*       CROUT : NAME OF THE CALLING ROUTINE : MCRRQST, MCRDELT, MCRLIST 
915 */
916 /*                ,CRINCR OR CRPROT */
917 /*       NUM :  MESSAGE NUMBER */
918 /*       IT : TABLE OF INTEGER DATA */
919 /*       XT : TABLE OF REAL DATA */
920 /*       CT : ------------------ CHARACTER */
921
922 /*     OUTPUT ARGUMENTS : */
923 /*     --------------------- */
924 /*       NONE */
925
926 /*     COMMONS USED : */
927 /*     ------------------ */
928
929 /*     REFERENCES CALLED : */
930 /*     --------------------- */
931
932 /*     DESCRIPTION/NOTES/LIMITATIONS : */
933 /*     ----------------------------------- */
934
935 /*   ROUTINE FOR TEMPORARY USE, WAITING FOR THE 'NEW' MESSAGE */
936 /*    (STRIM 3.3 ?), TO MAKE THE ROUTINES OF ALLOC USABLE */
937 /*    IN STRIM T-M . */
938
939 /*   DEPENDING ON THE LANGUAGE, WRITING OF THE REQUIRED MESSAGE ON */
940 /*   UNIT IMP . */
941 /*   (REUSE OF SPECIFS OF VFORMA) */
942
943 /*   THE MESSAGE IS INITIALIZED AT 'MESSAGE MISSING', AND IT IS */
944 /*   REPLACED BY THE REQUIRED MESSAGE IF EXISTS. */
945 /* > */
946 /* ***********************************************************************
947  */
948
949 /*  LOCAL : */
950
951 /* ----------------------------------------------------------------------*
952  */
953 /*  FIND MESSAGE DEPENDING ON THE LANGUAGE , THE ROUTINE */
954 /*  AND THE MESSAGE NUMBER */
955
956 /*  READING OF THE LANGUAGE : */
957     /* Parameter adjustments */
958   ct -= ct_len;
959   --xt;
960   --it;
961   
962   /* Function Body */
963   mamdlng_(cln, 3L);
964   
965 /*  INUM : TYPE OF MESSAGE  : 0 AS TEXT, 1 1 INTEGER TO BE WRITTEN */
966 /*        -1 MESSAGE INEXISTING (1 INTEGER AND 1 CHAIN) */
967
968   inum = -1;
969 /*
970   if (__s__cmp(cln, "FRA", 3L, 3L) == 0) {
971     __s__copy(cfm, "('   Il manque le message numero ',I5' pour le programm\
972 e de nom : ',A8)", 80L, 71L);
973     if (__s__cmp(crout, "MCRLIST", crout_len, 7L) == 0) {
974       if (*num == 1) {
975         inum = 1;
976         __s__copy(cfm, "(/,' Nombre d''allocation(s) de memoire effectu\
977 ee(s) : ',I6,/)", 80L, 62L);
978       } else if (*num == 2) {
979         inum = 1;
980         __s__copy(cfm, "(' Taille de l''allocation = ',I12)", 80L, 35L);
981       } else if (*num == 3) {
982         inum = 1;
983         __s__copy(cfm, "(' Taille totale allouee  = ',I12 /)", 80L, 36L);
984       }
985     } else if (__s__cmp(crout, "MCRDELT", crout_len, 7L) == 0) {
986       if (*num == 1) {
987         inum = 0;
988         __s__copy(cfm, "(' L''allocation de memoire a detruire n''exist\
989 e pas  ')", 80L, 56L);
990       } else if (*num == 2) {
991         inum = 0;
992         __s__copy(cfm, "(' Le systeme refuse une destruction d''allocat\
993 ion de memoire  ')", 80L, 65L);
994       }
995     } else if (__s__cmp(crout, "MCRRQST", crout_len, 7L) == 0) {
996       if (*num == 1) {
997         inum = 1;
998         __s__copy(cfm, "(' Le nombre maxi d''allocations de memoire est\
999  atteint :',I6)", 80L, 62L);
1000       } else if (*num == 2) {
1001         inum = 1;
1002         __s__copy(cfm, "(' Unite d''allocation invalide : ',I12)", 80L, 
1003                   40L);
1004       } else if (*num == 3) {
1005         inum = 1;
1006         __s__copy(cfm, "(' Le systeme refuse une allocation de memoire \
1007 de ',I12,' octets')", 80L, 66L);
1008       }
1009     } else if (__s__cmp(crout, "CRINCR", crout_len, 6L) == 0) {
1010       if (*num == 1) {
1011         inum = 0;
1012         __s__copy(cfm, "(' L''allocation de memoire a incrementer n''ex\
1013 iste pas')", 80L, 57L);
1014       }
1015     } else if (__s__cmp(crout, "CRPROT", crout_len, 6L) == 0) {
1016       if (*num == 1) {
1017         inum = 1;
1018         __s__copy(cfm, "(' Le niveau de protection est invalide ( =< 0 \
1019 ) : ',I12)", 80L, 57L);
1020       }
1021     }
1022     
1023   } else if (__s__cmp(cln, "DEU", 3L, 3L) == 0) {
1024     __s__copy(cfm, "('   Es fehlt die Meldung Nummer ',I5,' fuer das Progra\
1025 mm des Namens : ',A8)", 80L, 76L);
1026     if (__s__cmp(crout, "MCRLIST", crout_len, 7L) == 0) {
1027       if (*num == 1) {
1028         inum = 1;
1029         __s__copy(cfm, "(/,' Anzahl der ausgefuehrten dynamischen Anwei\
1030 sung(en) : ',I6,/)", 80L, 65L);
1031       } else if (*num == 2) {
1032         inum = 1;
1033         __s__copy(cfm, "(' Groesse der Zuweisung = ',I12)", 80L, 33L);
1034       } else if (*num == 3) {
1035         inum = 1;
1036         __s__copy(cfm, "(' Gesamtgroesse der Zuweisung = ',I12,/)", 80L, 
1037                   41L);
1038       }
1039     } else if (__s__cmp(crout, "MCRDELT", crout_len, 7L) == 0) {
1040       if (*num == 1) {
1041         inum = 0;
1042         __s__copy(cfm, "(' Zu loeschende dynamische Zuweisung existiert\
1043  nicht !! ')", 80L, 59L);
1044       } else if (*num == 2) {
1045         inum = 0;
1046         __s__copy(cfm, "(' System verweigert Loeschung der dynamischen \
1047 Zuweisung !!')", 80L, 61L);
1048       }
1049     } else if (__s__cmp(crout, "MCRRQST", crout_len, 7L) == 0) {
1050       if (*num == 1) {
1051         inum = 1;
1052         __s__copy(cfm, "(' Hoechstzahl dynamischer Zuweisungen ist erre\
1053 icht :',I6)", 80L, 58L);
1054       } else if (*num == 2) {
1055         inum = 1;
1056         __s__copy(cfm, "(' Falsche Zuweisungseinheit : ',I12)", 80L, 37L)
1057           ;
1058       } else if (*num == 3) {
1059         inum = 1;
1060         __s__copy(cfm, "(' System verweigert dynamische Zuweisung von '\
1061 ,I12,' Bytes')", 80L, 61L);
1062       }
1063     } else if (__s__cmp(crout, "CRINCR", crout_len, 6L) == 0) {
1064       if (*num == 1) {
1065         inum = 0;
1066         __s__copy(cfm, "(' Zu inkrementierende dynamische Zuweisung exi\
1067 stiert nicht !! ')", 80L, 65L);
1068       }
1069     } else if (__s__cmp(crout, "CRPROT", crout_len, 6L) == 0) {
1070       if (*num == 1) {
1071         inum = 1;
1072         __s__copy(cfm, "(' Sicherungsniveau ist nicht richtig ( =< 0 ) \
1073 : ',I12)", 80L, 55L);
1074       }
1075     }
1076     
1077   } else {
1078     __s__copy(cfm, "('   Message number ',I5,' is missing '                \
1079             ,'for program named: ',A8)", 80L, 93L);
1080     if (__s__cmp(crout, "MCRLIST", crout_len, 7L) == 0) {
1081       if (*num == 1) {
1082         inum = 1;
1083         __s__copy(cfm, "(/,' number of memory allocations carried out: \
1084 ',I6,/)", 80L, 54L);
1085       } else if (*num == 2) {
1086         inum = 1;
1087         __s__copy(cfm, "(' size of allocation = ',I12)", 80L, 30L);
1088       } else if (*num == 3) {
1089         inum = 1;
1090         __s__copy(cfm, "(' total size allocated = ',I12,/)", 80L, 34L);
1091       }
1092     } else if (__s__cmp(crout, "MCRDELT", crout_len, 7L) == 0) {
1093       if (*num == 1) {
1094         inum = 0;
1095         __s__copy(cfm, "(' Memory allocation to delete does not exist !\
1096 ! ')", 80L, 51L);
1097       } else if (*num == 2) {
1098         inum = 0;
1099         __s__copy(cfm, "(' System refuses deletion of memory allocation\
1100  !! ')", 80L, 53L);
1101       }
1102     } else if (__s__cmp(crout, "MCRRQST", crout_len, 7L) == 0) {
1103       if (*num == 1) {
1104         inum = 1;
1105         __s__copy(cfm, "(' max number of memory allocations reached :',\
1106 I6)", 80L, 50L);
1107       } else if (*num == 2) {
1108         inum = 1;
1109         __s__copy(cfm, "(' incorrect unit of allocation : ',I12)", 80L, 
1110                   40L);
1111       } else if (*num == 3) {
1112         inum = 1;
1113         __s__copy(cfm, "(' system refuses a memory allocation of ',I12,\
1114 ' bytes ')", 80L, 57L);
1115       }
1116     } else if (__s__cmp(crout, "CRINCR", crout_len, 6L) == 0) {
1117       if (*num == 1) {
1118         inum = 0;
1119         __s__copy(cfm, "(' Memory allocation to increment does not exis\
1120 t !! ')", 80L, 54L);
1121       }
1122     } else if (__s__cmp(crout, "CRPROT", crout_len, 6L) == 0) {
1123       if (*num == 1) {
1124         inum = 1;
1125         __s__copy(cfm, "(' level of protection is incorrect ( =< 0 ) : \
1126 ',I12)", 80L, 53L);
1127       }
1128     }
1129   }
1130   */
1131   /* ----------------------------------------------------------------------*
1132    */
1133   /*  iMPLEMENTATION OF WRITE , WITH OR WITHOUT DATA : */
1134   
1135   iunite = AdvApp2Var_SysBase::mnfnimp_();
1136   if (inum == 0) {
1137     io___5.ciunit = iunite;
1138     /*
1139     s__wsfe(&io___5);
1140     */
1141     AdvApp2Var_SysBase::e__wsfe();
1142   } else if (inum == 1) {
1143     io___6.ciunit = iunite;
1144     /*
1145     s__wsfe(&io___6);
1146     */
1147     /*
1148     do__fio(&c__1, (char *)&it[1], (ftnlen)sizeof(integer));
1149     */
1150     AdvApp2Var_SysBase::e__wsfe();
1151   } else {
1152     /*  MESSAGE DOES NOT EXIST ... */
1153     io___7.ciunit = iunite;
1154     /*
1155     s__wsfe(&io___7);
1156     */
1157     /*
1158     do__fio(&c__1, (char *)&(*num), (ftnlen)sizeof(integer));
1159     do__fio(&c__1, crout, crout_len);
1160     */
1161     AdvApp2Var_SysBase::e__wsfe();
1162   }
1163   
1164   return 0;
1165 } /* macrmsg_ */
1166 //=======================================================================
1167 //function : macrstw_
1168 //purpose  : 
1169 //=======================================================================
1170 int macrstw_(intptr_t *,//iadfld, 
1171              intptr_t *,//iadflf, 
1172              integer *)//nalloc)
1173
1174 {
1175   return 0 ;
1176 } /* macrstw_ */
1177
1178 //=======================================================================
1179 //function : madbtbk_
1180 //purpose  : 
1181 //=======================================================================
1182 int madbtbk_(integer *indice)
1183 {
1184   *indice = 0;
1185   return 0 ;
1186 } /* madbtbk_ */
1187
1188 //=======================================================================
1189 //function : AdvApp2Var_SysBase::maermsg_
1190 //purpose  : 
1191 //=======================================================================
1192 int AdvApp2Var_SysBase::maermsg_(const char *,//cnompg, 
1193                                  integer *,//icoder, 
1194                                  ftnlen )//cnompg_len)
1195
1196 {
1197   return 0 ;
1198 } /* maermsg_ */
1199
1200 //=======================================================================
1201 //function : magtlog_
1202 //purpose  : 
1203 //=======================================================================
1204 int magtlog_(const char *cnmlog, 
1205              const char *,//chaine, 
1206              integer *long__, 
1207              integer *iercod, 
1208              ftnlen cnmlog_len, 
1209              ftnlen )//chaine_len)
1210
1211 {
1212  
1213   /* Local variables */
1214   static char cbid[255];
1215   static integer ibid, ier;
1216   
1217
1218 /* ********************************************************************** 
1219 */
1220
1221 /*     FUNCTION : */
1222 /*     ---------- */
1223 /*        RETURN TRANSLATION OF "NAME LOGIC STRIM" IN */
1224 /*        "INTERNAL SYNTAX" CORRESPONDING TO "PLACE OF RANKING" */
1225
1226 /*     KEYWORDS : */
1227 /*     ----------- */
1228 /*        NOM LOGIQUE STRIM , TRADUCTION */
1229
1230 /*     INPUT ARGUMENTS : */
1231 /*     ------------------ */
1232 /*        CNMLOG : NAME OF "NAME LOGIC STRIM" TO TRANSLATE */
1233
1234 /*     OUTPUT ARGUMENTS  : */
1235 /*     ------------------- */
1236 /*        CHAINE : ADDRESS OF "PLACE OF RANKING" */
1237 /*        LONG   : USEFUL LENGTH OF "PLACE OF RANKING" */
1238 /*        IERCOD : ERROR CODE */
1239 /*        IERCOD = 0 : OK */
1240 /*        IERCOD = 5 : PLACE OF RANKING CORRESPONDING TO INEXISTING LOGIC NAME */
1241         
1242 /*        IERCOD = 6 : TRANSLATION TOO LONG FOR THE 'CHAIN' VARIABLE */
1243 /*        IERCOD = 7 : CRITICAL ERROR */
1244
1245 /*     COMMONS USED   : */
1246 /*     ---------------- */
1247 /*        NONE */
1248
1249 /*     REFERENCES CALLED   : */
1250 /*     --------------------- */
1251 /*        GNMLOG, MACHDIM */
1252
1253 /*     DESCRIPTION/NOTES/LIMITATIONS : */
1254 /*     ------------------------------- */
1255
1256 /*        SPECIFIC SGI ROUTINE */
1257
1258 /*        IN ALL CASES WHEN IERCOD IS >0, NO RESULT IS RETURNED*/
1259 /*        NOTION OF  "USER SYNTAX' AND "INTERNAL SYNTAX" */
1260 /*        --------------------------------------------------- */
1261
1262 /*       THE "USER SYNTAX" IS THE SYNTAX WHERE THE USER*/
1263 /*       VISUALIZES OR INDICATES THE FILE OR DIRECTORY NAME */
1264 /*       DURING A SESSION OF STRIM100 */
1265
1266 /*        "INTERNAL SYNTAX" IS SYNTAX USED TO CARRY OUT */
1267 /*        OPERATIONS OF FILE PROCESSING INSIDE THE CODE */
1268 /*        (OPEN,INQUIRE,...ETC) */
1269
1270 /* > */
1271 /* ***********************************************************************
1272  */
1273 /*              DECLARATIONS */
1274 /* ***********************************************************************
1275  */
1276
1277
1278 /* ***********************************************************************
1279  */
1280 /*              PROCESSING */
1281 /* ***********************************************************************
1282  */
1283
1284   *long__ = 0;
1285   *iercod = 0;
1286   
1287   /* CONTROL OF EXISTENCE OF THE LOGIC NAME */
1288   
1289   matrlog_(cnmlog, cbid, &ibid, &ier, cnmlog_len, 255L);
1290   if (ier == 1) {
1291     goto L9500;
1292   }
1293   if (ier == 2) {
1294     goto L9700;
1295   }
1296   
1297   /* CONTROL OF THE LENGTH OF CHAIN */
1298   
1299   if (ibid > __i__len()/*chaine, chaine_len)*/) {
1300     goto L9600;
1301   }
1302   
1303   //__s__copy(chaine, cbid, chaine_len, ibid);
1304   *long__ = ibid;
1305   
1306   goto L9999;
1307   
1308   /* ***********************************************************************
1309    */
1310   /*              ERROR PROCESSING */
1311   /* ***********************************************************************
1312    */
1313   
1314  L9500:
1315   *iercod = 5;
1316   //__s__copy(chaine, " ", chaine_len, 1L);
1317   goto L9999;
1318   
1319  L9600:
1320   *iercod = 6;
1321   //__s__copy(chaine, " ", chaine_len, 1L);
1322   goto L9999;
1323   
1324  L9700:
1325   *iercod = 7;
1326   //__s__copy(chaine, " ", chaine_len, 1L);
1327   
1328   /* ***********************************************************************
1329    */
1330   /*              RETURN TO THE CALLING PROGRAM */
1331   /* ***********************************************************************
1332    */
1333   
1334  L9999:
1335   return 0;
1336 } /* magtlog_ */
1337
1338 //=======================================================================
1339 //function : mainial_
1340 //purpose  : 
1341 //=======================================================================
1342 int AdvApp2Var_SysBase::mainial_()
1343 {
1344   mcrgene_.ncore = 0;
1345   return 0 ;
1346 } /* mainial_ */
1347
1348 //=======================================================================
1349 //function : AdvApp2Var_SysBase::maitbr8_
1350 //purpose  : 
1351 //=======================================================================
1352 int AdvApp2Var_SysBase::maitbr8_(integer *itaill, 
1353                                  doublereal *xtab, 
1354                                  doublereal *xval) 
1355
1356 {
1357   static integer c__504 = 504;
1358
1359   /* Initialized data */
1360
1361   static doublereal buff0[63] = { 
1362     0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,
1363     0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,
1364     0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,0.,
1365     0.,0.,0.,0.,0. 
1366     };
1367   
1368   /* System generated locals */
1369   integer i__1;
1370   
1371   /* Local variables */
1372   static integer i__;
1373   static doublereal buffx[63];
1374   static integer nbfois, noffst, nreste, nufois;
1375
1376 /* ***********************************************************************
1377  */
1378
1379 /*     FUNCTION : */
1380 /*     ---------- */
1381 /*       INITIALIZATION TO A GIVEN VALUE OF A TABLE OF REAL *8 */
1382
1383 /*     KEYWORDS : */
1384 /*     ----------- */
1385 /*       MANIPULATIONS, MEMORY, INITIALIZATION, DOUBLE-PRECISION */
1386
1387 /*     INPUT ARGUMENTS : */
1388 /*     ----------------- */
1389 /*        ITAILL : SIZE OF THE TABLE */
1390 /*        XTAB   : TABLE TO INITIALIZE WITH XVAL */
1391 /*        XVAL   : VALUE TO SET IN XTAB(FROM 1 TO ITAILL) */
1392
1393 /*     OUTPUT ARGUMENTS : */
1394 /*     ------------------ */
1395 /*        XTAB   : INITIALIZED TABLE */
1396
1397 /*     COMMONS USED : */
1398 /*     -------------- */
1399
1400 /*     REFERENCES CALLED : */
1401 /*     ------------------- */
1402
1403 /*     DESCRIPTION/NOTES/LIMITATIONS : */
1404 /*     ----------------------------------- */
1405
1406 /*   ONE CALLS MCRFILL WHICH MOVES BY PACKS OF 63 REALS */
1407
1408 /*   THE INITIAL PACK IS BUFF0 INITIATED BY DATA IF THE VALUE IS 0 */
1409 /*   OR OTHERWISE BUFFX INITIATED BY XVAL (LOOP). */
1410
1411
1412 /*   PORTABILITY : YES */
1413 /*   ACCESS : FREE */
1414
1415
1416 /* > */
1417 /* ***********************************************************************
1418  */
1419
1420   
1421   /* Parameter adjustments */
1422   --xtab;
1423   
1424   /* Function Body */
1425   
1426   /* ----------------------------------------------------------------------*
1427    */
1428   
1429   nbfois = *itaill / 63;
1430   noffst = nbfois * 63;
1431   nreste = *itaill - noffst;
1432   
1433   if (*xval == 0.) {
1434     if (nbfois >= 1) {
1435       i__1 = nbfois;
1436       for (nufois = 1; nufois <= i__1; ++nufois) {
1437         AdvApp2Var_SysBase::mcrfill_(&c__504, buff0, &xtab[(nufois - 1) * 63 + 1]);
1438         /* L1000: */
1439       }
1440     }
1441     
1442     if (nreste >= 1) {
1443       i__1 = nreste << 3;
1444       AdvApp2Var_SysBase::mcrfill_(&i__1, buff0, &xtab[noffst + 1]);
1445     }
1446   } else {
1447     for (i__ = 1; i__ <= 63; ++i__) {
1448       buffx[i__ - 1] = *xval;
1449       /* L2000: */
1450     }
1451     if (nbfois >= 1) {
1452       i__1 = nbfois;
1453       for (nufois = 1; nufois <= i__1; ++nufois) {
1454         AdvApp2Var_SysBase::mcrfill_(&c__504, buffx, &xtab[(nufois - 1) * 63 + 1]);
1455         /* L3000: */
1456       }
1457     }
1458     
1459     if (nreste >= 1) {
1460       i__1 = nreste << 3;
1461       AdvApp2Var_SysBase::mcrfill_(&i__1, buffx, &xtab[noffst + 1]);
1462     }
1463   }
1464   
1465   /* ----------------------------------------------------------------------*
1466    */
1467   
1468   return 0;
1469 } /* maitbr8_ */
1470
1471 //=======================================================================
1472 //function : mamdlng_
1473 //purpose  : 
1474 //=======================================================================
1475 int mamdlng_(char *,//cmdlng, 
1476              ftnlen )//cmdlng_len)
1477
1478 {
1479  
1480
1481 /* ***********************************************************************
1482  */
1483
1484 /*     FUNCTION : */
1485 /*     ---------- */
1486 /*   RETURN THE CURRENT LANGUAGE */
1487
1488 /*     KEYWORDS : */
1489 /*     ----------- */
1490 /*   MANAGEMENT, CONFIGURATION, LANGUAGE, READING */
1491
1492 /*     INPUT ARGUMENTS : */
1493 /*     -------------------- */
1494 /*       CMDLNG : LANGUAGE */
1495
1496 /*     OUTPUT ARGUMENTS  : */
1497 /*     ------------------- */
1498 /*       NONE */
1499
1500 /*     COMMONS USED : */
1501 /*     ------------------ */
1502 /*       MACETAT */
1503
1504 /*     REFERENCES CALLED : */
1505 /*     --------------------- */
1506 /*       NONE */
1507
1508 /*     DESCRIPTION/NOTES/LIMITATIONS : */
1509 /*     ----------------------------------- */
1510 /*       RIGHT OF USAGE : ANY APPLICATION */
1511
1512 /*       ATTENTION : THIS ROUTINE DEPENDS ON PRELIMINARY INITIALISATION */
1513 /*       ----------  WITH AMDGEN. */
1514 /*                   SO IT IS ENOUGH TO PROVIDE THAT THIS INIT IS */
1515 /*                   CORRECTLY IMPLEMENTED IN THE RESPECTIVE PROGRAMS */
1516 /* > */
1517 /* ***********************************************************************
1518  */
1519
1520
1521 /*     INCLUDE MACETAT */
1522 /* < */
1523
1524 /* ***********************************************************************
1525  */
1526
1527 /*     FUNCTION : */
1528 /*     ---------- */
1529 /*        CONTAINS INFORMATIONS ABOUT THE COMPOSITION OF */
1530 /*        THE EXECUTABLE AND ITS ENVIRONMENT : */
1531 /*        - LANGUAGES */
1532 /*        - PRESENT APPLICATIONS */
1533 /*        - AUTHORIZED TYPES OF ENTITIES (NON USED) */
1534 /*        AND INFORMATION DESCRIBING THE CURRENT STATE : */
1535 /*        - CURRENT APPLICATION */
1536 /*        - MODE OF USAGE (NOT USED) */
1537
1538 /*     KEYWORDS : */
1539 /*     ----------- */
1540 /*        APPLICATION, LANGUAGE */
1541
1542 /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
1543 /*     ----------------------------------- */
1544
1545 /*     A) CHLANG*4 : LIST OF POSSIBLE VALUES OF THE LANGUAGE : */
1546 /*                   'FRA ','DEU ','ENG ' */
1547
1548 /*        CHL10N*4 : LIST OF POSSIBLE VALUES OF THE LOCALIZATION : */
1549 /*                   'FRA ','DEU ','ENG ', 'JIS ' */
1550
1551 /*     B) CHCOUR*4, CHPREC*4, CHSUIV*4 : CURRENT, PREVIOUS AND NEXT APPLICATION
1552
1553 /*     C) CHMODE*4 : CURRENT MODE (NOT USED) */
1554
1555 /*     D) CHPRES*2 (1:NBRMOD) : LIST OF APPLICATIONS TAKEN INTO ACCOUNT */
1556
1557 /*       Rang ! Code interne  !   Application */
1558 /*       ---------------------------------------------------------- */
1559 /*        1   !   CD          !   Modeling 2D */
1560 /*        2   !   CA          !   Modeling 2D by learning */
1561 /*        3   !   CP          !   Parameterized 2D modelization */
1562 /*        4   !   PC          !   Rheological 2D modelization */
1563 /*        5   !   CU          !   Milling 2 Axes 1/2 */
1564 /*        6   !   CT          !   Turning */
1565 /*        7   !   TS          !   3D surface modeling */
1566 /*        8   !   TV          !   3D volume modeling */
1567 /*        9   !   MC          !   Surface Meshing */
1568 /*        10  !   MV          !   Volume Meshing */
1569 /*        11  !   TU          !   Machining by 3 axes */
1570 /*        12  !   T5          !   Machining by 3-5 axes */
1571 /*        13  !   TR          !   Machinning by 5 axes of regular surfaces */
1572 /*        14  !   IG          !   Interface IGES */
1573 /*        15  !   ST          !   Interface SET */
1574 /*        16  !   VD          !   Interface VDA */
1575 /*        17  !   IM          !   Interface of modeling */
1576 /*        18  !   GA          !   Generator APT/IFAPT */
1577 /*        19  !   GC          !   Generator COMPACT II */
1578 /*        20  !   GP          !   Generator PROMO */
1579 /*        21  !   TN          !   Machining by numerical copying */
1580 /*        22  !   GM          !   Management of models */
1581 /*        23  !   GT          !   Management of trace */
1582 /*       ---------------------------------------------------------- */
1583
1584
1585
1586 /* > */
1587 /* ***********************************************************************
1588  */
1589
1590 /*     NUMBER OF APPLICATIONS TAKEN INTO ACCOUNT */
1591
1592
1593 /*     NUMBER OF ENTITY TYPES MANAGED BY STRIM 100 */
1594   //__s__copy(cmdlng, macetat_.chlang, cmdlng_len, 4L);
1595   
1596   return 0 ;
1597 } /* mamdlng_ */
1598
1599 //=======================================================================
1600 //function : maostrb_
1601 //purpose  : 
1602 //=======================================================================
1603 int maostrb_()
1604 {
1605   return 0 ;
1606 } /* maostrb_ */
1607
1608 //=======================================================================
1609 //function : maostrd_
1610 //purpose  : 
1611 //=======================================================================
1612 int maostrd_()
1613 {
1614   static integer imod;
1615   
1616 /* ***********************************************************************
1617  */
1618
1619 /*     FUNCTION : */
1620 /*     ---------- */
1621 /*       REFINE TRACE-BACK IN PRODUCTION PHASE */
1622
1623 /*     KEYWORDS : */
1624 /*     ----------- */
1625 /*       FUNCTION, SYSTEM, TRACE-BACK, REFINING, DEBUG */
1626
1627 /*     INPUT ARGUMENTS : */
1628 /*     ----------------- */
1629 /*       NONE */
1630
1631 /*     OUTPUT ARGUMENTS E : */
1632 /*     -------------------- */
1633 /*        NONE */
1634
1635 /*     COMMONS USED : */
1636 /*     -------------- */
1637 /*        NONE */
1638
1639 /*     REFERENCES CALLED : */
1640 /*     ------------------- */
1641 /*       MADBTBK */
1642
1643 /*     DESCRIPTION/NOTES/LIMITATIONS : */
1644 /*     ----------------------------------- */
1645 /*       THIS ROUTINE SHOULD BE CALLED TO REFINE */
1646 /*       TRACE-BACK IN PRODUCTION PHASE AND LEAVE TO TESTERS THE  */
1647 /*       POSSIBILITY TO GET TRACE-BACK IN */
1648 /*       CLIENT VERSIONS IF ONE OF THE FOLLOWING CONDITIONS IS */
1649 /*       VERIFIED : */
1650 /*       - EXISTENCE OF SYMBOL 'STRMTRBK' */
1651 /*       - EXISTENCE OF FILE 'STRMINIT:STRMTRBK.DAT' */
1652
1653
1654 /* > */
1655 /* ***********************************************************************
1656  */
1657   madbtbk_(&imod);
1658   if (imod == 1) {
1659     maostrb_();
1660   }
1661   return 0 ;
1662 } /* maostrd_ */
1663
1664 //=======================================================================
1665 //function : maoverf_
1666 //purpose  : 
1667 //=======================================================================
1668 int maoverf_(integer *nbentr, 
1669              doublereal *dtable) 
1670
1671 {
1672   /* Initialized data */
1673   
1674   static integer ifois = 0;
1675   
1676   /* System generated locals */
1677   integer i__1;
1678   
1679   /* Local variables */
1680   static integer ibid;
1681   static doublereal buff[63];
1682   static integer ioct, indic, nrest, icompt;
1683
1684 /* ***********************************************************************
1685  */
1686
1687 /*     FUNCTION : */
1688 /*     ---------- */
1689 /*       Initialisation in overflow of a tableau with DOUBLE PRECISION */
1690
1691 /*     KEYWORDS : */
1692 /*     ----------- */
1693 /*       MANIPULATION, MEMORY, INITIALISATION, OVERFLOW */
1694
1695 /*     INPUT ARGUMENTS : */
1696 /*     ----------------- */
1697 /*       NBENTR : Number of entries in the table */
1698
1699 /*     OUTPUT ARGUMENTS : */
1700 /*     ------------------ */
1701 /*       DATBLE : Table double precision initialized in overflow */
1702
1703 /*     COMMONS USED : */
1704 /*     ------------------ */
1705 /*       R8OVR contained in the include MAOVPAR.INC */
1706
1707 /*     REFERENCES CALLED : */
1708 /*     --------------------- */
1709 /*       MCRFILL */
1710
1711 /*     DESCRIPTION/NOTES/LIMITATIONS : */
1712 /*     ----------------------------------- */
1713 /*       1) Doc. programmer : */
1714
1715 /*       This routine initialized to positive overflow a table with */
1716 /*       DOUBLE PRECISION. */
1717
1718 /*       Other types of tables (INTEGER*2, INTEGER, REAL, ...) */
1719 /*       are not managed by the routine. */
1720
1721 /*       It is usable in phase of developpement to detect the */
1722 /*       errors of initialization. */
1723
1724 /*       In official version, these calls will be inactive. */
1725
1726 /*       ACCESs : Agreed with AC. */
1727
1728 /*       The routine does not return error code. */
1729
1730 /*       Argument NBELEM should be positive. */
1731 /*       If it is negative or null, display message "MAOVERF : NBELEM = */
1732 /*       valeur_de_NBELEM" and a Trace Back by the call of routine MAOSTRB. */
1733
1734
1735 /*       2) Doc. designer  : */
1736
1737 /*                  The idea is to minimize the number of calls */
1738 /*                to the routine of transfer of numeric zones, */
1739 /*   ----------   for the reason of performance. */
1740 /*  !  buffer  !    For this a table of NLONGR 
1741 /*  !__________!  DOUBLE PRECISIONs is reserved. This buffer is initialized by */
1742 /*  <---------->  the instruction DATA. The overflow is accessed in a  */
1743 /*    NLONGR*8    specific COMMON not by a routine as */
1744 /*                the initialisation is done by DATA. */
1745
1746 /*                * If NBENTR<NLONGR, a part of the buffer is transfered*/
1747 /*     DTABLE     in DTABLE. */
1748 /*   __________ */
1749 /*  !  amorce  !  * Otherwise, the entire buffer is transfered in DTABLE. */
1750 /*  !__________!  This initiates it. Then a loop is execute, which at each  
1751 */
1752 /*  !  temps 1 !  iteration transfers the part of the already initialized table */
1753 /*  !__________!  in the one that was not yet initialized. */
1754 /*  !          !  The size of the zone transfered by each call to MCRFILL 
1755 */
1756 /*  !  temps 2 !  is NLONGR*2**(numero_de_l'iteration). When  
1757 */
1758 /*  !          !  the size of the table to be initialized is */
1759 /*  !__________!  less than the already initialized size, the loop is */
1760 /*  !          !  abandoned and thev last transfer is carried out to */
1761 /*  !          !  initialize the remaining table, except for the case when the size */
1762 /*  !          !  of the table is of type NLONGR*2**K. */
1763 /*  !  temps 3 ! */
1764 /*  !          !  * NLONGR will be equal to 19200. */
1765 /*  !          ! */
1766 /*  !          ! */
1767 /*  !__________! */
1768 /*  !  reste   ! */
1769 /*  !__________! */
1770
1771
1772 /* > */
1773 /* ***********************************************************************
1774  */
1775
1776 /* Inclusion of MAOVPAR.INC */
1777
1778 /*      CONSTANTS */
1779 /*     INCLUDE MAOVPAR */
1780 /* ***********************************************************************
1781  */
1782
1783 /*     FUNCTION : */
1784 /*     ---------- */
1785 /*       DEFINES SPECIFIC LIMITED VALUES. */
1786
1787 /*     KEYWORDS : */
1788 /*     ----------- */
1789 /*       SYSTEM, LIMITS, VALUES, SPECIFIC */
1790
1791 /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
1792 /*     ----------------------------------- */
1793 /*     *** THEY CAN'T BE REMOVED DURING EXECUTION. */
1794
1795 /*     *** THE VALUES OF UNDERFLOW AND OVERFLOW CAN'T BE  */
1796 /*     DEFINED IN DECIMAL VALUES (ERROR OF COMPILATION D_FLOAT) */
1797 /*     THEY ARE DEFINED AS HEXADECIMAL VALUES */
1798
1799
1800 /* > */
1801 /* ***********************************************************************
1802  */
1803
1804
1805 /*    DECLARATION OF THE COMMON FOR NUMERIC TYPES */
1806
1807
1808 /*    DECLARATION OF THE COMMON FOR CHARACTER TYPES*/
1809
1810
1811
1812 /*      LOCAL VARIABLES */
1813
1814 /*      TABLES */
1815
1816 /*      DATAS */
1817     /* Parameter adjustments */
1818   --dtable;
1819   
1820   /* Function Body */
1821   
1822   /* vJMB R8OVR IS NOT YET initialized, so impossible to use DATA
1823    */
1824   /*         DATA BUFF / NLONGR * R8OVR / */
1825   
1826   /*    init of BUFF is done only once */
1827   
1828   if (ifois == 0) {
1829     for (icompt = 1; icompt <= 63; ++icompt) {
1830       buff[icompt - 1] = maovpar_.r8ovr;
1831       /* L20: */
1832     }
1833     ifois = 1;
1834   }
1835   
1836   /* ^JMB */
1837   /* Exception */
1838   if (*nbentr < 63) {
1839     nrest = *nbentr << 3;
1840     AdvApp2Var_SysBase::mcrfill_(&nrest, buff, &dtable[1]);
1841   } else {
1842     
1843     /* Start & initialization */
1844     ioct = 504;
1845     AdvApp2Var_SysBase::mcrfill_(&ioct, buff, &dtable[1]);
1846     indic = 63;
1847     
1848     /* Loop. The upper limit is the integer value of the logarithm of base 2
1849      */
1850     /* of NBENTR/NLONGR. */
1851     i__1 = (integer) (log((real) (*nbentr) / (float)63.) / log((float)2.))
1852       ;
1853     for (ibid = 1; ibid <= i__1; ++ibid) {
1854       
1855       AdvApp2Var_SysBase::mcrfill_(&ioct, &dtable[1], &dtable[indic + 1]);
1856       ioct += ioct;
1857       indic += indic;
1858       
1859       /* L10: */
1860     }
1861     
1862     nrest = ( *nbentr - indic ) << 3;
1863     
1864     if (nrest > 0) {
1865       AdvApp2Var_SysBase::mcrfill_(&nrest, &dtable[1], &dtable[indic + 1]);
1866     }
1867     
1868   }
1869   return 0 ;
1870 } /* maoverf_ */
1871
1872 //=======================================================================
1873 //function : AdvApp2Var_SysBase::maovsr8_
1874 //purpose  : 
1875 //=======================================================================
1876 int AdvApp2Var_SysBase::maovsr8_(integer *ivalcs) 
1877 {
1878   *ivalcs = maovpar_.r8ncs;
1879   return 0 ;
1880 } /* maovsr8_ */
1881
1882 //=======================================================================
1883 //function : matrlog_
1884 //purpose  : 
1885 //=======================================================================
1886 int matrlog_(const char *,//cnmlog, 
1887              const char *,//chaine, 
1888              integer *length, 
1889              integer *iercod, 
1890              ftnlen ,//cnmlog_len, 
1891              ftnlen )//chaine_len)
1892
1893 {
1894   *iercod = 1;
1895   *length = 0;
1896   
1897   return 0 ;
1898 } /* matrlog_ */
1899
1900 //=======================================================================
1901 //function : matrsym_
1902 //purpose  : 
1903 //=======================================================================
1904 int matrsym_(const char *cnmsym, 
1905              const char *,//chaine, 
1906              integer *length, 
1907              integer *iercod, 
1908              ftnlen cnmsym_len, 
1909              ftnlen )//chaine_len)
1910
1911 {
1912   /* Local variables */
1913   static char chainx[255];
1914
1915 /* ***********************************************************************
1916  */
1917
1918 /*     FUNCTION : */
1919 /*     ---------- */
1920 /*       RETURN THE VALUE OF A SYMBOL DEFINED DURING THE */
1921 /*       INITIALISATION OF A USER */
1922
1923 /*     KEYWORDS : */
1924 /*     ----------- */
1925 /*       TRANSLATION, SYMBOL */
1926
1927 /*     INPUT ARGUMENTS : */
1928 /*     -------------------- */
1929 /*       CNMSYM : NAME OF THE SYMBOL */
1930
1931 /*     OUTPUT ARGUMENTS : */
1932 /*     ------------------ */
1933 /*       CHAINE : TRANSLATION OF THE SYMBOL */
1934 /*       LENGTH : USEFUL LENGTH OF THE CHAIN */
1935 /*       IERCOD : ERROR CODE */
1936 /*              = 0 : OK */
1937 /*              = 1 : INEXISTING SYMBOL */
1938 /*              = 2 : OTHER ERROR */
1939
1940 /*     COMMONS USED : */
1941 /*     ------------------ */
1942 /*       NONE */
1943
1944 /*     REFERENCES CALLED : */
1945 /*     --------------------- */
1946 /*       LIB$GET_SYMBOL,MACHDIM */
1947
1948 /*     DESCRIPTION/NOTES/LIMITATIONS : */
1949 /*     ----------------------------------- */
1950 /*       - THIS ROUTINE IS VAX SPECIFIC */
1951 /*       - IN CASE OF ERROR (IERCOD>0), CHAIN = ' ' AND LENGTH = 0 */
1952 /*       - IF THE INPUT VARIABLE CNMSYM IS EMPTY, THE ROUTINE RETURNS IERCOD=1*/
1953 /* > */
1954 /* ***********************************************************************
1955  */
1956
1957
1958 /* SGI...v */
1959   
1960   /* SGI  CALL MAGTLOG (CNMSYM,CHAINE,LENGTH,IERCOD) */
1961   magtlog_(cnmsym, chainx, length, iercod, cnmsym_len, 255L);
1962   /* SO...v */
1963   if (*iercod == 5) {
1964     *iercod = 1;
1965   }
1966   /* SO...^ */
1967   if (*iercod >= 2) {
1968     *iercod = 2;
1969   }
1970   //if (__s__cmp(chainx, "NONE", 255L, 4L) == 0) {
1971   if (__s__cmp() == 0) {
1972     //__s__copy(chainx, " ", 255L, 1L);
1973     *length = 0;
1974   }
1975   //__s__copy(chaine, chainx, chaine_len, 255L);
1976   /* SGI...^ */
1977   
1978   
1979   /* ***********************************************************************
1980    */
1981   /*     ERROR PROCESSING */
1982   /* ***********************************************************************
1983    */
1984   
1985   
1986   /* L9999: */
1987   return 0;
1988 } /* matrsym_ */
1989
1990 //=======================================================================
1991 //function : mcrcomm_
1992 //purpose  : 
1993 //=======================================================================
1994 int mcrcomm_(integer *kop, 
1995              integer *noct, 
1996              intptr_t *iadr, 
1997              integer *ier)
1998
1999 {
2000   /* Initialized data */
2001   
2002   static integer ntab = 0;
2003   
2004   /* System generated locals */
2005   integer i__1, i__2;
2006   
2007   /* Local variables */
2008   static intptr_t ideb;
2009   static doublereal dtab[32000];
2010   static intptr_t itab[160]     /* was [4][40] */;
2011   static intptr_t ipre;
2012   static integer i__, j, k;
2013   
2014
2015 /************************************************************************
2016 *******/
2017
2018 /*     FUNCTION : */
2019 /*     ---------- */
2020 /*        DYNAMIC ALLOCATION ON COMMON */
2021
2022 /*     KEYWORDS : */
2023 /*     ----------- */
2024 /*        . ALLOCDYNAMIQUE, MEMORY, COMMON, ALLOC */
2025
2026 /*     INPUT ARGUMENTS : */
2027 /*     ------------------ */
2028 /*        KOP    : (1,2) = (ALLOCATION,DESTRUCTION) */
2029 /*        NOCT   : NUMBER OF OCTETS */
2030
2031 /*     OUTPUT ARGUMENTS  : */
2032 /*     ------------------- */
2033 /*        IADR   : ADDRESS IN MEMORY OF THE FIRST OCTET */
2034 /*        *      : */
2035 /*        *      : */
2036 /*        IERCOD : ERROR CODE */
2037
2038 /*        IERCOD = 0 : OK */
2039 /*        IERCOD > 0 : CRITICAL ERROR  */
2040 /*        IERCOD < 0 : WARNING */
2041 /*        IERCOD = 1 : ERROR DESCRIPTION */
2042 /*        IERCOD = 2 : ERROR DESCRIPTION */
2043
2044 /*     COMMONS USED   : */
2045 /*     ---------------- */
2046
2047 /*    CRGEN2 */
2048
2049 /*     REFERENCES CALLED   : */
2050 /*     ---------------------- */
2051
2052 /*     Type  Name */
2053 /*           MCRLOCV */
2054
2055 /*     DESCRIPTION/NOTES/LIMITATIONS : */
2056 /*     ----------------------------------- */
2057
2058 /*   ATTENTION .... ITAB ARE NTAB NOT SAVED BETWEEN 2 CALLS.. 
2059 */
2060
2061 /* > */
2062 /* ***********************************************************************
2063  */
2064
2065 /* JPF  PARAMETER ( MAXNUM = 40 , MAXCOM = 500 * 1024 ) */
2066
2067 /*  ITAB : TABLE OF MANAGEMENT OF DTAB, ALLOCATED MEMORY ZONE . */
2068 /*  NTAB : NUMBER OF COMPLETED ALLOCATIONS. */
2069 /*     FORMAT OF ITAB : NUMBER OF ALLOCATED REAL*8, ADDRESS OF THE 1ST REAL*8 
2070 */
2071 /*                      , NOCT , VIRTUAL ADDRESS */
2072
2073 /* PP      COMMON / CRGEN2 / DTAB */
2074
2075
2076 /* ----------------------------------------------------------------------*
2077  */
2078
2079   *ier = 0;
2080   
2081   /*  ALLOCATION : FIND A HOLE */
2082   
2083   if (*kop == 1) {
2084     *iadr = 0;
2085     if (*noct < 1) {
2086       *ier = 1;
2087       goto L9900;
2088     }
2089     if (ntab >= 40) {
2090       *ier = 2;
2091       goto L9900;
2092     }
2093     
2094     i__1 = ntab + 1;
2095     for (i__ = 1; i__ <= i__1; ++i__) {
2096       if (i__ <= 1) {
2097         ipre = 1;
2098       } else {
2099         ipre = itab[((i__ - 1) << 2) - 3] + itab[((i__ - 1) << 2) - 4];
2100       }
2101       if (i__ <= ntab) {
2102         ideb = itab[(i__ << 2) - 3];
2103       } else {
2104         ideb = 32001;
2105       }
2106       if ((ideb - ipre) << 3 >= *noct) {
2107         /*  A HOLE WAS FOUND */
2108         i__2 = i__;
2109         for (j = ntab; j >= i__2; --j) {
2110           for (k = 1; k <= 4; ++k) {
2111             itab[k + ((j + 1) << 2) - 5] = itab[k + (j << 2) - 5];
2112             /* L1003: */
2113           }
2114           /* L1002: */
2115         }
2116         ++ntab;
2117         itab[(i__ << 2) - 4] = *noct / 8 + 1;
2118         itab[(i__ << 2) - 3] = ipre;
2119         itab[(i__ << 2) - 2] = *noct;
2120         mcrlocv_(&dtab[ipre - 1], iadr);
2121         itab[(i__ << 2) - 1] = *iadr;
2122         goto L9900;
2123       }
2124       /* L1001: */
2125     }
2126     
2127     /*  NO HOLE */
2128     
2129     *ier = 3;
2130     goto L9900;
2131     
2132     /* ----------------------------------- */
2133     /*  DESTRUCTION OF THE ALLOCATION NUM : */
2134     
2135   } else {
2136     i__1 = ntab;
2137     for (i__ = 1; i__ <= i__1; ++i__) {
2138       if (*noct != itab[(i__ << 2) - 2]) {
2139         goto L2001;
2140       }
2141       if (*iadr != itab[(i__ << 2) - 1]) {
2142         goto L2001;
2143       }
2144       /*  THE ALLOCATION TO BE REMOVED WAS FOUND */
2145       i__2 = ntab;
2146       for (j = i__ + 1; j <= i__2; ++j) {
2147         for (k = 1; k <= 4; ++k) {
2148           itab[k + ((j - 1) << 2) - 5] = itab[k + (j << 2) - 5];
2149           /* L2003: */
2150         }
2151         /* L2002: */
2152       }
2153       --ntab;
2154       goto L9900;
2155     L2001:
2156       ;
2157     }
2158     
2159     /*        THE ALLOCATION DOES NOT EXIST */
2160     
2161     *ier = 4;
2162     /* PP         GOTO 9900 */
2163   }
2164   
2165  L9900:
2166   return 0;
2167 } /* mcrcomm_ */
2168
2169 //=======================================================================
2170 //function : AdvApp2Var_SysBase::mcrdelt_
2171 //purpose  : 
2172 //=======================================================================
2173 int AdvApp2Var_SysBase::mcrdelt_(integer *iunit, 
2174                                  integer *isize, 
2175                                  void *t, 
2176                                  intptr_t *iofset, 
2177                                  integer *iercod)
2178
2179 {
2180   static integer ibid;
2181   static doublereal xbid;
2182   static integer noct, iver, ksys, i__, n, nrang, 
2183   ibyte, ier;
2184   static intptr_t iadfd,  iadff, iaddr, loc; /* Les adrresses en long*/
2185   static integer kop;
2186   
2187 /* ***********************************************************************
2188  */
2189
2190 /*     FUNCTION : */
2191 /*     ---------- */
2192 /*        DESTRUCTION OF A DYNAMIC ALLOCATION */
2193
2194 /*     KEYWORDS : */
2195 /*     ----------- */
2196 /*        SYSTEM, ALLOCATION, MEMORY, DESTRUCTION */
2197
2198 /*     INPUT ARGUMENTS : */
2199 /*     ------------------ */
2200 /*        IUNIT  : NUMBER OF OCTETS OF THE ALLOCATION UNIT */
2201 /*        ISIZE  : NUMBER OF UNITS REQUIRED */
2202 /*        T      : REFERENCE ADDRESS */
2203 /*        IOFSET : OFFSET */
2204
2205 /*     OUTPUT ARGUMENTS : */
2206 /*     ------------------- */
2207 /*        IERCOD : ERROR CODE */
2208 /*               = 0 : OK */
2209 /*               = 1 : PB OF DE-ALLOCATION OF A ZONE ALLOCATED IN COMMON */
2210 /*               = 2 : THE SYSTEM REFUSES TO DEMAND DE-ALLOCATION */
2211 /*               = 3 : THE ALLOCATION TO BE DESTROYED DOES NOT EXIST. */
2212
2213 /*     COMMONS USED   : */
2214 /*     ---------------- */
2215
2216
2217 /*     REFERENCES CALLED   : */
2218 /*     --------------------- */
2219
2220
2221 /*     DESCRIPTION/NOTES/LIMITATIONS : */
2222 /*     ----------------------------------- */
2223
2224 /*     1) UTILISATEUR */
2225 /*        ----------- */
2226
2227 /*       MCRDELT FREES ALLOCATED MEMORY ZONE */
2228 /*       BY ROUTINE MCRRQST (OR CRINCR) */
2229
2230 /*       THE MEANING OF ARGUMENTS IS THE SAME AS MCRRQST */
2231
2232 /* *** ATTENTION : */
2233 /*     ----------- */
2234 /*     IERCOD=2 : CASE WHEN THE SYSTEM CANNOT FREE THE ALLOCATED MEMORY, */
2235 /*     THE FOLLOWING MESSAGE APPEARS SYSTEMATICALLY ON CONSOLE ALPHA : */
2236 /*     "THe system refuseS destruction of memory allocation" */
2237
2238 /*     IERCOD=3 CORRESPONDS TO THE CASE WHEN THE ARGUMENTS ARE NOT CORRECT */
2239 /*     (THEY DO NOT ALLOW TO RECOGNIZE THE ALLOCATION IN THE TABLE) 
2240 */
2241
2242 /*     When the allocation is destroyed, the corresponding IOFSET is set to */
2243 /*     2 147 483 647. So, if one gets access to the table via IOFSET, there is  */
2244 /*     a trap. This allows to check that the freed memory zone is not usede. This verification is */
2245 /*     valid only if the same sub-program uses and destroys the allocation. */
2246
2247 /* > */
2248 /* ***********************************************************************
2249  */
2250
2251 /* COMMON OF PARAMETERS */
2252
2253 /* COMMON OF STATISTICS */
2254 /*     INCLUDE MCRGENE */
2255
2256 /* ***********************************************************************
2257  */
2258
2259 /*     FUNCTION : */
2260 /*     ---------- */
2261 /*       TABLE OF MANAGEMENT OF DYNAMIC ALLOCATIONS IN MEMORY */
2262
2263 /*     KEYWORS : */
2264 /*     ----------- */
2265 /*       SYSTEM, MEMORY, ALLOCATION */
2266
2267 /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
2268 /*     ----------------------------------- */
2269
2270
2271 /* > */
2272 /* ***********************************************************************
2273  */
2274 /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
2275 /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
2276 /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
2277 /*         2 : UNIT OF ALLOCATION */
2278 /*         3 : NB OF ALLOCATED UNITS */
2279 /*         4 : REFERENCE ADDRESS OF THE TABLE */
2280 /*         5 : IOFSET */
2281 /*         6 : STATIC ALLOCATION NUMBER */
2282 /*         7 : Required allocation size */
2283 /*         8 : address of the beginning of allocation */
2284 /*         9 : Size of the USER ZONE */
2285 /*        10 : ADDRESS of the START FLAG */
2286 /*        11 : ADDRESS of the END FLAG */
2287 /*        12 : Rank of creation of the allocation */
2288
2289 /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
2290 /*   NCORE : NB OF CURRENT ALLOCS */
2291 /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
2292 /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */
2293
2294
2295
2296 /* ----------------------------------------------------------------------*
2297  */
2298
2299
2300 /*     20-10-86 : BF ; INITIAL VERSION  */
2301
2302
2303 /*     NRQST : NUMBER OF ALLOCATIONS  */
2304 /*     NDELT : NUMBER OF LIBERATIONS */
2305 /*     NBYTE : TOTAL NUMBER OF OCTETS OF ALLOCATIONS */
2306 /*     MBYTE : MAX NUMBER OF OCTETS */
2307
2308     /* Function Body */
2309     *iercod = 0;
2310
2311 /* SEARCH IN MCRGENE */
2312
2313     n = 0;
2314     mcrlocv_(t, &loc);
2315
2316     for (i__ = mcrgene_.ncore; i__ >= 1; --i__) {
2317         if (*iunit == mcrgene_.icore[i__ * 12 - 11] && *isize == 
2318                 mcrgene_.icore[i__ * 12 - 10] && loc == mcrgene_.icore[i__ *
2319                  12 - 9] && *iofset == mcrgene_.icore[i__ * 12 - 8]) {
2320             n = i__;
2321             goto L1100;
2322         }
2323 /* L1001: */
2324     }
2325 L1100:
2326
2327 /* IF THE ALLOCATION DOES NOT EXIST, LEAVE */
2328
2329     if (n <= 0) {
2330         goto L9003;
2331     }
2332
2333 /* ALLOCATION RECOGNIZED : RETURN OTHER INFOS */
2334
2335     ksys = static_cast<integer> (mcrgene_.icore[n * 12 - 7]);
2336     ibyte = static_cast<integer> (mcrgene_.icore[n * 12 - 6]);
2337     iaddr = mcrgene_.icore[n * 12 - 5];
2338     iadfd = mcrgene_.icore[n * 12 - 3];
2339     iadff = mcrgene_.icore[n * 12 - 2];
2340     nrang = static_cast<integer> (mcrgene_.icore[n * 12 - 1]);
2341
2342 /*     Control of flags */
2343
2344     madbtbk_(&iver);
2345     if (iver == 1) {
2346         macrchk_();
2347     }
2348
2349     if (ksys <= 1) {
2350 /* DE-ALLOCATION ON COMMON */
2351         kop = 2;
2352         mcrcomm_(&kop, &ibyte, &iaddr, &ier);
2353         if (ier != 0) {
2354             goto L9001;
2355         }
2356     } else {
2357 /* DE-ALLOCATION SYSTEM */
2358         mcrfree_(&ibyte, reinterpret_cast<void**> (&iaddr), &ier);
2359         if (ier != 0) {
2360             goto L9002;
2361         }
2362     }
2363
2364 /* CALL ALLOWING TO CANCEL AUTOMATIC WATCH BY THE DEBUGGER */
2365
2366     macrclw_(&iadfd, &iadff, &nrang);
2367
2368 /* UPDATE OF STATISTICS */
2369     if (ksys <= 1) {
2370         i__ = 1;
2371     } else {
2372         i__ = 2;
2373     }
2374     ++mcrstac_.ndelt[i__ - 1];
2375     mcrstac_.nbyte[i__ - 1] -= static_cast<integer> (mcrgene_.icore[n * 12 - 11] * 
2376             mcrgene_.icore[n * 12 - 10]);
2377
2378 /* REMOVAL OF PARAMETERS IN MCRGENE */
2379     if (n < 1000) {
2380 /*      noct = (mcrgene_1.ncore - n) * 48; */
2381         noct = (mcrgene_.ncore - n) * 12 * sizeof(mcrgene_.icore[0]);
2382         AdvApp2Var_SysBase::mcrfill_(&noct, 
2383                                      &mcrgene_.icore[(n + 1) * 12 - 12], 
2384                                      &mcrgene_.icore[n * 12 - 12]);
2385     }
2386     --mcrgene_.ncore;
2387
2388 /* *** Set to overflow of IOFSET */
2389     {
2390        /* nested scope needed to avoid gcc compilation error crossing
2391           initialization with goto*/
2392        /* assign max positive integer to *iofset */
2393        const size_t shift = sizeof (*iofset) * 8 - 1;
2394        *iofset = (uintptr_t(1) << shift) - 1 /*2147483647 for 32bit*/;
2395     }
2396     goto L9900;
2397
2398 /* ----------------------------------------------------------------------*
2399  */
2400 /*     ERROR PROCESSING */
2401
2402 L9001:
2403 /*  REFUSE DE-ALLOCATION BY ROUTINE 'MCRCOMM' (ALLOC DS COMMON) */
2404     *iercod = 1;
2405     AdvApp2Var_SysBase::maermsg_("MCRDELT", iercod, 7L);
2406     maostrd_();
2407     goto L9900;
2408
2409 /*  REFUSE DE-ALLOCATION BY THE SYSTEM */
2410 L9002:
2411     *iercod = 2;
2412     AdvApp2Var_SysBase::maermsg_("MCRDELT", iercod, 7L);
2413     macrmsg_("MCRDELT", iercod, &ibid, &xbid, " ", 7L, 1L);
2414     maostrd_();
2415     goto L9900;
2416
2417 /* ALLOCATION DOES NOT EXIST */
2418 L9003:
2419     *iercod = 3;
2420     AdvApp2Var_SysBase::maermsg_("MCRDELT", iercod, 7L);
2421     maostrd_();
2422     goto L9900;
2423
2424 L9900:
2425
2426  return 0   ;
2427
2428 } /* mcrdelt_ */
2429
2430
2431 /*
2432 C*********************************************************************
2433 C
2434 C     FUNCTION :
2435 C     ----------
2436 C        Transfer a memory zone in another by managing intersections
2437 C
2438 C     KEYWORDS :
2439 C     -----------
2440 C        MANIPULATION, MEMORY, TRANSFER, CHARACTER
2441 C
2442 C     INPUT ARGUMENTS :
2443 C     -----------------
2444 C        nb_car    : integer*4  number of characters to transfer.
2445 C        source    : source memory zone.
2446 C             
2447 C     OUTPUT ARGUMENTS  :
2448 C     -------------------
2449 C        dest      : zone memory destination.
2450 C
2451 C     COMMONS USED :
2452 C     ----------------
2453 C
2454 C     REFERENCES CALLED :
2455 C     -------------------
2456 C
2457 C     DEMSCRIPTION/NOTES/LIMITATIONS :
2458 C     -----------------------------------
2459 C        Routine portable UNIX (SGI, ULTRIX, BULL)
2460 C
2461
2462 C>
2463 C**********************************************************************
2464 */
2465
2466 //=======================================================================
2467 //function : AdvApp2Var_SysBase::mcrfill_
2468 //purpose  : 
2469 //=======================================================================
2470 int AdvApp2Var_SysBase::mcrfill_(integer *size, 
2471                                  void *tin, 
2472                                  void *tout)
2473
2474 {
2475   register char *jmin=static_cast<char*> (tin);
2476   register char *jmout=static_cast<char*> (tout);
2477   if (mcrfill_ABS(jmout-jmin) >= *size)
2478     memcpy( tout, tin, *size);
2479   else if (tin > tout)
2480     {
2481       register integer n = *size;
2482       while (n-- > 0) *jmout++ = *jmin++;
2483     }
2484   else
2485     {
2486       register integer n = *size;
2487       jmin+=n;
2488       jmout+=n;
2489       while (n-- > 0) *--jmout = *--jmin;
2490     }
2491   return 0;
2492 }
2493
2494
2495 /*........................................................................*/
2496 /*                                                                        */
2497 /*   FUNCTION :                                                           */
2498 /*   ----------                                                           */
2499 /*               Routines for management of the dynamic memory.               */
2500 /*                                                                        */
2501 /*             Routine mcrfree                                            */
2502 /*             --------------                                             */
2503 /*                                                                        */
2504 /*             Desallocation of a memory zone  .                          */
2505 /*                                                                        */
2506 /*             CALL MCRFREE (IBYTE,IADR,IER)                              */
2507 /*                                                                        */
2508 /*             IBYTE INTEGER*4 : Nb of Octets to free                     */
2509 /*                                                                        */
2510 /*             IADR POINTEUR   : Start Address                            */
2511 /*                                                                        */
2512 /*             IER  INTEGER*4  : Return Code                              */
2513 /*                                                                        */
2514 /*                                                                        */
2515 /*........................................................................*/
2516 /*                                                                        */
2517
2518 //=======================================================================
2519 //function : mcrfree_
2520 //purpose  : 
2521 //=======================================================================
2522 int mcrfree_(integer *,//ibyte,
2523              void* *iadr,
2524              integer *ier)
2525
2526 {
2527   *ier=0;
2528   Standard::Free(*iadr);
2529   //Standard::Free always nullifies address, so check becomes incorrect
2530   //if ( !*iadr ) *ier = 1;
2531   return 0;
2532 }
2533
2534 /*........................................................................*/
2535 /*                                                                        */
2536 /*   FONCTION :                                                           */
2537 /*   ----------                                                           */
2538 /*               Routines for management of the dynamic memory.           */
2539 /*                                                                        */
2540 /*             Routine mcrgetv                                            */
2541 /*             --------------                                             */
2542 /*                                                                        */
2543 /*               Demand of memory allocation.                             */
2544 /*                                                                        */
2545 /*               CALL MCRGETV(IBYTE,IADR,IER)                             */
2546 /*                                                                        */
2547 /*               IBYTE (INTEGER*4) Nb of Bytes of allocation required     */    
2548 /*                                                                        */
2549 /*               IADR   (INTEGER*4) : Result.                             */
2550 /*                                                                        */
2551 /*               IER (INTEGER*4)    : Error Code    :                     */
2552 /*                                                                        */
2553 /*                   = 0  ==> OK                                          */
2554 /*                   = 1  ==> Allocation impossible                       */
2555 /*                   = -1 ==> Ofset > 2**31 - 1                           */
2556 /*                                                                        */
2557
2558 /*                                                                        */
2559 /*........................................................................*/
2560
2561 //=======================================================================
2562 //function : mcrgetv_
2563 //purpose  : 
2564 //=======================================================================
2565 int mcrgetv_(integer *sz,
2566              void* *iad,
2567              integer *ier)                                            
2568
2569 {
2570   
2571   *ier = 0;
2572   *iad = Standard::Allocate(*sz);
2573   if ( !*iad ) *ier = 1;
2574   return 0;
2575 }
2576
2577
2578 //=======================================================================
2579 //function : mcrlist_
2580 //purpose  : 
2581 //=======================================================================
2582 int mcrlist_(integer *ier)
2583
2584 {
2585   /* System generated locals */
2586   integer i__1;
2587   
2588   /* Builtin functions */
2589   
2590   /* Local variables */
2591   static char cfmt[1];
2592   static doublereal dfmt;
2593   static integer ifmt, i__, nufmt, ntotal;
2594   static char subrou[7];
2595   
2596
2597 /************************************************************************
2598 *******/
2599
2600 /*     FUNCTION : */
2601 /*     ---------- */
2602 /*   PRINT TABLE OF CURRENT DYNAMIC ALLOCATIONS */
2603
2604 /*     KEYWORDS : */
2605 /*     ----------- */
2606 /*   SYSTEM, ALLOCATION, MEMORY, LIST */
2607
2608 /*     INPUT ARGUMENTS : */
2609 /*     ------------------ */
2610 /*        . NONE */
2611
2612 /*     OUTPUT ARGUMENTS : */
2613 /*     ------------------- */
2614 /*        *      : */
2615 /*        *      : */
2616 /*        IERCOD : ERROR CODE */
2617
2618 /*        IERCOD = 0 : OK */
2619 /*        IERCOD > 0 : SERIOUS ERROR  */
2620 /*        IERCOD < 0 : WARNING */
2621 /*        IERCOD = 1 : ERROR DESCRIPTION */
2622 /*        IERCOD = 2 : ERROR DESCRIPTION */
2623
2624 /*     COMMONS USED   : */
2625 /*     ---------------- */
2626
2627 /*    MCRGENE     VFORMT */
2628
2629 /*     REFERENCES CALLED   : */
2630 /*     ---------------------- */
2631
2632 /*     Type  Name */
2633 /*           VFORMA */
2634
2635 /*     DESCRIPTION/NOTES/LIMITATIONS : */
2636 /*     ----------------------------------- */
2637 /*         . NONE */
2638
2639
2640
2641 /* > */
2642 /* ***********************************************************************
2643  */
2644
2645 /*     INCLUDE MCRGENE */
2646 /* ***********************************************************************
2647  */
2648
2649 /*     FUNCTION : */
2650 /*     ---------- */
2651 /*        TABLE FOR MANAGEMENT OF DYNAMIC MEMORY ALLOCATIONS */
2652
2653 /*     KEYWORDS : */
2654 /*     ----------- */
2655 /*        SYSTEM, MEMORY, ALLOCATION */
2656
2657 /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
2658 /*     ----------------------------------- */
2659
2660
2661 /* > */
2662 /* ***********************************************************************
2663  */
2664
2665 /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
2666 /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
2667 /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
2668 /*         2 : UNIT OF ALLOCATION */
2669 /*         3 : NB OF ALLOCATED UNITS */
2670 /*         4 : REFERENCE ADDRESS OF THE TABLE */
2671 /*         5 : IOFSET */
2672 /*         6 : STATIC ALLOCATION NUMBER */
2673 /*         7 : Required allocation size */
2674 /*         8 : address of the beginning of allocation */
2675 /*         9 : Size of the USER ZONE */
2676 /*        10 : ADDRESS of the START FLAG */
2677 /*        11 : ADDRESS of the END FLAG */
2678 /*        12 : Rank of creation of the allocation */
2679
2680 /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
2681 /*   NCORE : NB OF CURRENT ALLOCS */
2682 /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
2683 /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */
2684
2685
2686
2687 /* ----------------------------------------------------------------------*
2688  */
2689
2690
2691 /* ----------------------------------------------------------------------*
2692  */
2693
2694     *ier = 0;
2695     //__s__copy(subrou, "MCRLIST", 7L, 7L);
2696
2697 /*     WRITE HEADING */
2698
2699     nufmt = 1;
2700     ifmt = mcrgene_.ncore;
2701     macrmsg_(subrou, &nufmt, &ifmt, &dfmt, cfmt, 7L, 1L);
2702
2703     ntotal = 0;
2704
2705     i__1 = mcrgene_.ncore;
2706     for (i__ = 1; i__ <= i__1; ++i__) {
2707         nufmt = 2;
2708         ifmt = static_cast<integer> (mcrgene_.icore[i__ * 12 - 11] * mcrgene_.icore[i__ * 12 - 10])
2709                 ;
2710         macrmsg_(subrou, &nufmt, &ifmt, &dfmt, cfmt, 7L, 1L);
2711         ntotal += ifmt;
2712 /* L1001: */
2713     }
2714
2715     nufmt = 3;
2716     ifmt = ntotal;
2717     macrmsg_(subrou, &nufmt, &ifmt, &dfmt, cfmt, 7L, 1L);
2718
2719  return 0 ;
2720 } /* mcrlist_ */
2721
2722
2723 //=======================================================================
2724 //function : mcrlocv_
2725 //purpose  : 
2726 //=======================================================================
2727 int mcrlocv_(void* t,
2728              intptr_t *l)
2729
2730 {
2731   *l = reinterpret_cast<intptr_t> (t);
2732   return 0 ;
2733 }
2734
2735 //=======================================================================
2736 //function : AdvApp2Var_SysBase::mcrrqst_
2737 //purpose  : 
2738 //=======================================================================
2739 int AdvApp2Var_SysBase::mcrrqst_(integer *iunit, 
2740                                  integer *isize, 
2741                                  void *t, 
2742                                  intptr_t *iofset, 
2743                                  integer *iercod)
2744
2745 {
2746
2747   integer i__1, i__2;
2748
2749   /* Local variables */
2750   static doublereal dfmt;
2751   static integer ifmt, iver;
2752   static char subr[7];
2753   static integer ksys , ibyte, irest, isyst, ier;
2754   static intptr_t iadfd, iadff, iaddr,lofset, loc;
2755   static integer izu;
2756
2757   
2758 /* ********************************************************************** 
2759 */
2760
2761 /*     FUNCTION : */
2762 /*     ---------- */
2763 /*       IMPLEMENTATION OF DYNAMIC MEMORY ALLOCATION */
2764
2765 /*     KEYWORDS : */
2766 /*     ----------- */
2767 /*       SYSTEM, ALLOCATION, MEMORY, REALISATION */
2768
2769 /*     INPUT ARGUMENTS : */
2770 /*     ------------------ */
2771 /*        IUNIT  : NUMBER OF OCTET OF THE UNIT OF ALLOCATION */
2772 /*        ISIZE  : NUMBER OF UNITS REQUIRED */
2773 /*        T      : REFERENCE ADDRESS */
2774
2775 /*     OUTPUT ARGUMENTS  : */
2776 /*     ------------------- */
2777 /*        IOFSET : OFFSET */
2778 /*        IERCOD : ERROR CODE, */
2779 /*               = 0 : OK */
2780 /*               = 1 : MAX NB OF ALLOCS REACHED */
2781 /*               = 2 : ARGUMENTS INCORRECT */
2782 /*               = 3 : REFUSED DYNAMIC ALLOCATION */
2783
2784 /*     COMMONS USED   : */
2785 /*     ---------------- */
2786 /*       MCRGENE, MCRSTAC */
2787
2788 /*     REFERENCES CALLED   : */
2789 /*     ----------------------- */
2790 /*       MACRCHK, MACRGFL, MACRMSG, MCRLOCV,MCRCOMM, MCRGETV */
2791
2792 /*     DESCRIPTION/NOTES/LIMITATIONS : */
2793 /*     ----------------------------------- */
2794
2795 /*     1) USER */
2796 /*     -------------- */
2797
2798 /* T IS THE ADDRESS OF A TABLE, IOFSET REPRESENTS THE DEPLACEMENT IN */
2799 /* UNITS OF IUNIT OCTETS BETWEEN THE ALLOCATED ZONE AND TABLE T */
2800 /* IERCOD=0 SIGNALS THAT THE ALLOCATION WORKS WELL, ANY OTHER */
2801 /* VALUE INDICATES A BUG. */
2802
2803 /*     EXAMPLE : */
2804 /*          LET THE DECLARATION REAL*4 T(1), SO IUNIT=4 . */
2805 /*          CALL TO MCRRQST PORODUCES DYNAMIC ALLOCATION */
2806 /*          AND GIVES VALUE TO VARIABLE IOFSET, */
2807 /*          IF IT IS REQUIRED TO WRITE 1. IN THE 5TH ZONE REAL*4 */
2808 /*          ALLOCATED IN THIS WAY, MAKE: */
2809 /*          T(5+IOFSET)=1. */
2810
2811 /*     CASE OF ERRORS : */
2812 /*     --------------- */
2813
2814 /*     IERCOD=1 : MAX NB OF ALLOCATION REACHED (ACTUALLY 200) */
2815 /*     AND THE FOLLOWING MESSAGE APPEARS IN THE CONSOLE ALPHA : */
2816 /*     "The max number of memory allocation is reached : ,N" */
2817
2818 /*     IERCOD=2 : ARGUMENT IUNIT INCORRECT AS IT IS DIFFERENT FROM 1,2,4 OR 8 */
2819 /*     AND THE FOLLOWING MESSAGE APPEARS IN THE CONSOLE ALPHA : */
2820 /*     "Unit OF allocation invalid : ,IUNIT" */
2821
2822 /*     IERCOD=3 : REFUSED DYNAMIC ALLOCATION (MORE PLACE IN MEMORY) */
2823 /*     AND THE FOLLOWING MESSAGE APPEARS IN THE CONSOLE ALPHA : */
2824 /*    "The system refuses dynamic allocation of memory of N octets" 
2825 */
2826 /*     with completev display of all allocations carried out till now */
2827
2828
2829 /*     2) DESIGNER */
2830 /*     -------------- */
2831
2832 /* MCRRQST MAKES DYNAMIC ALLOCATION OF VIRTUAL MEMORY ON THE BASE */
2833 /* OF ENTITIES OF 8 OCTETS (QUADWORDS), WHILE THE ALLOCATION IS REQUIRED BY */
2834 /* UNITS OF IUNIT OCTETS (1,2,4,8). */
2835
2836 /* THE REQUIRED QUANTITY IS IUNIT*ISIZE OCTETS, THIS VALUE IS ROUNDED */
2837 /* SO THAT THE ALLOCATION WAS AN INTEGER NUMBER OF QUADWORDS. */
2838
2839
2840
2841 /* > */
2842 /* ***********************************************************************
2843  */
2844
2845 /* COMMON OF PARAMETRES */
2846 /* COMMON OF INFORMATION ON STATISTICS */
2847 /*     INCLUDE MCRGENE */
2848
2849 /* ***********************************************************************
2850  */
2851 /*     FUNCTION : */
2852 /*     ---------- */
2853 /*        TABLE FOR MANAGEMENT OF DYNAMIC MEMORY ALLOCATIONS */
2854
2855 /*     KEYWORDS : */
2856 /*     ----------- */
2857 /*        SYSTEM, MEMORY, ALLOCATION */
2858
2859 /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
2860 /*     ----------------------------------- */
2861
2862
2863 /* > */
2864 /* ***********************************************************************
2865  */
2866
2867 /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
2868 /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
2869 /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
2870 /*         2 : UNIT OF ALLOCATION */
2871 /*         3 : NB OF ALLOCATED UNITS */
2872 /*         4 : REFERENCE ADDRESS OF THE TABLE */
2873 /*         5 : IOFSET */
2874 /*         6 : STATIC ALLOCATION NUMBER */
2875 /*         7 : Required allocation size */
2876 /*         8 : address of the beginning of allocation */
2877 /*         9 : Size of the USER ZONE */
2878 /*        10 : ADDRESS of the START FLAG */
2879 /*        11 : ADDRESS of the END FLAG */
2880 /*        12 : Rank of creation of the allocation */
2881
2882 /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
2883 /*   NCORE : NB OF CURRENT ALLOCS */
2884 /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
2885 /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */
2886
2887
2888
2889
2890 /* ----------------------------------------------------------------------*
2891  */
2892 /*     20-10-86 : BF ; INITIAL VERSION  */
2893
2894
2895 /*     NRQST : NUMBER OF ALLOCATIONS  */
2896 /*     NDELT : NUMBER OF LIBERATIONS */
2897 /*     NBYTE : TOTAL NUMBER OF OCTETS OF ALLOCATIONS */
2898 /*     MBYTE : MAX NUMBER OF OCTETS */
2899
2900
2901 /* ----------------------------------------------------------------------*
2902  */
2903
2904     /* Function Body */
2905     *iercod = 0;
2906
2907     if (mcrgene_.ncore >= 1000) {
2908         goto L9001;
2909     }
2910     if (*iunit != 1 && *iunit != 2 && *iunit != 4 && *iunit != 8) {
2911         goto L9002;
2912     }
2913
2914 /* Calculate the size required by the user */
2915     ibyte = *iunit * *isize;
2916
2917 /* Find the type of version (Phase of Production or Version Client) */
2918     madbtbk_(&iver);
2919
2920 /* Control allocated size in Production phase */
2921
2922     if (iver == 1) {
2923
2924         if (ibyte == 0) {
2925             //s__wsle(&io___3);
2926             //do__lio(&c__9, &c__1, "Require zero allocation", 26L);
2927             AdvApp2Var_SysBase::e__wsle();
2928             maostrb_();
2929         } else if (ibyte >= 4096000) {
2930             //s__wsle(&io___4);
2931             //do__lio(&c__9, &c__1, "Require allocation above 4 Mega-Octets : ", 50L);
2932             //do__lio(&c__3, &c__1, (char *)&ibyte, (ftnlen)sizeof(integer));
2933             AdvApp2Var_SysBase::e__wsle();
2934             maostrb_();
2935         }
2936
2937     }
2938
2939 /* CALCULATE THE SIZE OF THE USER ZONE (IZU) */
2940 /*     . add size required by the user (IBYTE) */
2941 /*     . add delta for alinement with the base */
2942 /*     . round to multiple of 8 above */
2943
2944   mcrlocv_(t, &loc);
2945     izu = ibyte + loc % *iunit;
2946     irest = izu % 8;
2947     if (irest != 0) {
2948         izu = izu + 8 - irest;
2949     }
2950
2951 /* CALCULATE THE SIZE REQUIRED FROM THE PRIMITIVE OF ALLOC */
2952 /*     . add size of the user zone */
2953 /*     . add 8 for alinement of start address of */
2954 /*       allocation on multiple of 8 so that to be able to  */
2955 /*       set flags with Double Precision without other pb than alignement */
2956 /*     . add 16 octets for two flags */
2957
2958     ibyte = izu + 24;
2959
2960 /* DEMAND OF ALLOCATION */
2961
2962     isyst = 0;
2963 /* L1001: */
2964 /*      IF ( ISYST.EQ.0.AND.IBYTE .LE. 100 * 1024 ) THEN */
2965 /*        ALLOCATION SUR TABLE */
2966 /*         KSYS = 1 */
2967 /*         KOP = 1 */
2968 /*         CALL MCRCOMM ( KOP , IBYTE , IADDR , IER ) */
2969 /*         IF ( IER .NE. 0 ) THEN */
2970 /*            ISYST=1 */
2971 /*            GOTO 1001 */
2972 /*         ENDIF */
2973 /*      ELSE */
2974 /*        ALLOCATION SYSTEME */
2975     ksys = 2;
2976     mcrgetv_(&ibyte, reinterpret_cast<void**> (&iaddr), &ier);
2977     if (ier != 0) {
2978         goto L9003;
2979     }
2980 /*      ENDIF */
2981
2982 /* CALCULATE THE ADDRESSES OF FLAGS */
2983
2984     iadfd = iaddr + 8 - iaddr % 8;
2985     iadff = iadfd + 8 + izu;
2986
2987 /* CALCULATE USER OFFSET : */
2988 /*     . difference between the user start address and the */
2989 /*       base address */
2990 /*     . converts this difference in the user unit */
2991
2992     lofset = iadfd + 8 + loc % *iunit - loc;
2993     *iofset = lofset / *iunit;
2994
2995 /* If phase of production control flags */
2996     if (iver == 1) {
2997         macrchk_();
2998     }
2999
3000 /*     SET FLAGS */
3001 /*     . the first flag is set by IADFD and the second by IADFF */
3002 /*     . if phase of production, set to overflow the ZU */
3003     macrgfl_(&iadfd, &iadff, &iver, &izu);
3004
3005 /* RANGING OF PARAMETERS IN MCRGENE */
3006
3007     ++mcrgene_.ncore;
3008     mcrgene_.icore[mcrgene_.ncore * 12 - 12] = mcrgene_.lprot;
3009     mcrgene_.icore[mcrgene_.ncore * 12 - 11] = *iunit;
3010     mcrgene_.icore[mcrgene_.ncore * 12 - 10] = *isize;
3011     mcrgene_.icore[mcrgene_.ncore * 12 - 9] = loc;
3012     mcrgene_.icore[mcrgene_.ncore * 12 - 8] = *iofset;
3013     mcrgene_.icore[mcrgene_.ncore * 12 - 7] = ksys;
3014     mcrgene_.icore[mcrgene_.ncore * 12 - 6] = ibyte;
3015     mcrgene_.icore[mcrgene_.ncore * 12 - 5] = iaddr;
3016     mcrgene_.icore[mcrgene_.ncore * 12 - 4] = mcrgene_.ncore;
3017     mcrgene_.icore[mcrgene_.ncore * 12 - 3] = iadfd;
3018     mcrgene_.icore[mcrgene_.ncore * 12 - 2] = iadff;
3019     mcrgene_.icore[mcrgene_.ncore * 12 - 1] = mcrgene_.ncore;
3020
3021     mcrgene_.lprot = 0;
3022
3023 /* CALL ALLOWING AUTOIMPLEMENTATION OF THE SET WATCH BY THE DEBUGGER */
3024
3025     macrstw_(&iadfd, &iadff, &mcrgene_.ncore);
3026
3027 /* STATISTICS */
3028
3029     ++mcrstac_.nrqst[ksys - 1];
3030     mcrstac_.nbyte[ksys - 1] += static_cast<integer> (mcrgene_.icore[mcrgene_.ncore * 12 - 11] * 
3031             mcrgene_.icore[mcrgene_.ncore * 12 - 10]);
3032 /* Computing MAX */
3033     i__1 = mcrstac_.mbyte[ksys - 1], i__2 = mcrstac_.nbyte[ksys - 1];
3034     mcrstac_.mbyte[ksys - 1] = advapp_max(i__1,i__2);
3035
3036     goto L9900;
3037
3038 /* ----------------------------------------------------------------------*
3039  */
3040 /*  ERROR PROCESSING */
3041
3042 /*  MAX NB OF ALLOC REACHED : */
3043 L9001:
3044     *iercod = 1;
3045     ifmt = 1000;
3046     //__s__copy(subr, "MCRRQST", 7L, 7L);
3047     macrmsg_(subr, iercod, &ifmt, &dfmt, " ", 7L, 1L);
3048     maostrd_();
3049     goto L9900;
3050
3051 /*  INCORRECT ARGUMENTS */
3052 L9002:
3053     *iercod = 2;
3054     ifmt = *iunit;
3055     //__s__copy(subr, "MCRRQST", 7L, 7L);
3056     macrmsg_(subr, iercod, &ifmt, &dfmt, " ", 7L, 1L);
3057     goto L9900;
3058
3059 /* SYSTEM REFUSES ALLOCATION */
3060 L9003:
3061     *iercod = 3;
3062     ifmt = ibyte;
3063     //__s__copy(subr, "MCRRQST", 7L, 7L);
3064     macrmsg_(subr, iercod, &ifmt, &dfmt, " ", 7L, 1L);
3065     maostrd_();
3066     mcrlist_(&ier);
3067     goto L9900;
3068
3069 /* ----------------------------------------------------------------------*
3070  */
3071
3072 L9900:
3073     mcrgene_.lprot = 0;
3074  return 0 ;
3075 } /* mcrrqst_ */
3076
3077 //=======================================================================
3078 //function : AdvApp2Var_SysBase::mgenmsg_
3079 //purpose  : 
3080 //=======================================================================
3081 int AdvApp2Var_SysBase::mgenmsg_(const char *,//nomprg, 
3082                                  ftnlen )//nomprg_len)
3083
3084 {
3085   return 0;
3086 } /* mgenmsg_ */
3087
3088 //=======================================================================
3089 //function : AdvApp2Var_SysBase::mgsomsg_
3090 //purpose  : 
3091 //=======================================================================
3092 int AdvApp2Var_SysBase::mgsomsg_(const char *,//nomprg, 
3093                                  ftnlen )//nomprg_len)
3094
3095 {
3096   return 0;
3097 } /* mgsomsg_ */
3098
3099
3100 /*
3101 C
3102 C*****************************************************************************
3103 C
3104 C     FUNCTION : CALL MIRAZ(LENGTH,ITAB)
3105 C     ---------- 
3106 C
3107 C     RESET TO ZERO A TABLE OF LOGIC OR INTEGER.
3108 C
3109 C     KEYWORDS :
3110 C     -----------
3111 C        RAZ INTEGER
3112 C
3113 C     INPUT ARGUMENTS  :
3114 C     ------------------
3115 C               LENGTH : NUMBER OF OCTETS TO TRANSFER
3116 C               ITAB   : NAME OF THE TABLE
3117 C
3118 C     OUTPUT ARGUMENTS  :
3119 C     -------------------
3120 C               ITAB   : NAME OF THE TABLE SET TO ZERO
3121 C
3122 C     COMMONS USED   :
3123 C     ----------------
3124 C
3125 C     REFERENCES CALLED   :
3126 C     ---------------------
3127 C
3128 C     DEMSCRIPTION/NOTES/LIMITATIONS :
3129 C     -----------------------------------
3130 C
3131 C           Portable VAX-SGI
3132
3133 C>
3134 C***********************************************************************
3135 */
3136 //=======================================================================
3137 //function : AdvApp2Var_SysBase::miraz_
3138 //purpose  : 
3139 //=======================================================================
3140 void AdvApp2Var_SysBase::miraz_(integer *taille,
3141                                 void *adt)
3142
3143 {
3144   integer offset;
3145   offset = *taille;
3146   memset(adt , '\0' , *taille) ;
3147 }
3148 //=======================================================================
3149 //function : AdvApp2Var_SysBase::mnfndeb_
3150 //purpose  : 
3151 //=======================================================================
3152 integer AdvApp2Var_SysBase::mnfndeb_()
3153 {
3154   integer ret_val;
3155   ret_val = 0;
3156   return ret_val;
3157 } /* mnfndeb_ */
3158
3159 //=======================================================================
3160 //function : AdvApp2Var_SysBase::mnfnimp_
3161 //purpose  : 
3162 //=======================================================================
3163 integer AdvApp2Var_SysBase::mnfnimp_()
3164 {
3165   integer ret_val;
3166   ret_val = 6;
3167   return ret_val;
3168 } /* mnfnimp_ */
3169
3170 //=======================================================================
3171 //function : AdvApp2Var_SysBase::msifill_
3172 //purpose  : 
3173 //=======================================================================
3174 int AdvApp2Var_SysBase::msifill_(integer *nbintg, 
3175                                  integer *ivecin,
3176                                  integer *ivecou)
3177 {
3178   static integer nocte;
3179   
3180 /* ***********************************************************************
3181  */
3182
3183 /*     FUNCTION : */
3184 /*     ---------- */
3185 /*      transfer Integer from one  zone to another */
3186
3187 /*     KEYWORDS : */
3188 /*     ----------- */
3189 /*        TRANSFER , INTEGER , MEMORY */
3190
3191 /*     INPUT ARGUMENTS : */
3192 /*     ------------------ */
3193 /*        NBINTG : Nb of integers */
3194 /*        IVECIN : Input vector */
3195
3196 /*     OUTPUT ARGUMENTS : */
3197 /*     ------------------- */
3198 /*        IVECOU : Output vector */
3199
3200 /*     COMMONS USED   : */
3201 /*     ---------------- */
3202
3203 /*     REFERENCES CALLED   : */
3204 /*     --------------------- */
3205
3206 /*     DESCRIPTION/NOTES/LIMITATIONS : */
3207 /*     ----------------------------------- */
3208
3209 /* > */
3210 /* ***********************************************************************
3211  */
3212
3213 /* ___ NOCTE : Number of octets to transfer */
3214
3215     /* Parameter adjustments */
3216     --ivecou;
3217     --ivecin;
3218
3219     /* Function Body */
3220     nocte =  *nbintg * sizeof(integer);
3221     AdvApp2Var_SysBase::mcrfill_(&nocte, &ivecin[1], &ivecou[1]);
3222  return 0 ;
3223 } /* msifill_ */
3224
3225 //=======================================================================
3226 //function : AdvApp2Var_SysBase::msrfill_
3227 //purpose  : 
3228 //=======================================================================
3229 int AdvApp2Var_SysBase::msrfill_(integer *nbreel, 
3230                                  doublereal *vecent,
3231                                  doublereal * vecsor)
3232 {
3233   static integer nocte;
3234   
3235
3236 /* ***********************************************************************
3237  */
3238
3239 /*     FONCTION : */
3240 /*     ---------- */
3241 /*        Transfer real from one zone to another */
3242
3243 /*     KEYWORDS : */
3244 /*     ----------- */
3245 /*        TRANSFER , REAL , MEMORY */
3246
3247 /*     INPUT ARGUMENTS : */
3248 /*     ----------------- */
3249 /*        NBREEL : Number of reals */
3250 /*        VECENT : Input vector */
3251
3252 /*     OUTPUT ARGUMENTS : */
3253 /*     ------------------- */
3254 /*        VECSOR : Output vector */
3255
3256 /*     COMMONS USED   : */
3257 /*     ---------------- */
3258
3259 /*     REFERENCES CALLED   : */
3260 /*     ----------------------- */
3261
3262 /*     DESCRIPTION/NOTES/LIMITATIONS : */
3263 /*     ----------------------------------- */
3264
3265 /* > */
3266 /* ***********************************************************************
3267  */
3268
3269 /* ___ NOCTE : Nb of octets to transfer */
3270
3271     /* Parameter adjustments */
3272     --vecsor;
3273     --vecent;
3274
3275     /* Function Body */
3276     nocte = *nbreel * sizeof (doublereal);
3277     AdvApp2Var_SysBase::mcrfill_(&nocte, &vecent[1], &vecsor[1]);
3278  return 0 ;
3279 } /* msrfill_ */
3280
3281 //=======================================================================
3282 //function : AdvApp2Var_SysBase::mswrdbg_
3283 //purpose  : 
3284 //=======================================================================
3285 int AdvApp2Var_SysBase::mswrdbg_(const char *,//ctexte, 
3286                                  ftnlen )//ctexte_len)
3287
3288 {
3289
3290   static cilist io___1 = { 0, 0, 0, 0, 0 };
3291   
3292
3293 /* ***********************************************************************
3294  */
3295
3296 /*     FUNCTION : */
3297 /*     ---------- */
3298 /*        Write message on console alpha if IBB>0 */
3299
3300 /*     KEYWORDS : */
3301 /*     ----------- */
3302 /*        MESSAGE, DEBUG */
3303
3304 /*     INPUT ARGUMENTS : */
3305 /*     ----------------- */
3306 /*        CTEXTE : Text to be written */
3307
3308 /*     OUTPUT ARGUMENTS  : */
3309 /*     ------------------- */
3310 /*        None */
3311
3312 /*     COMMONS USED   : */
3313 /*     ---------------- */
3314
3315 /*     REFERENCES CALLED   : */
3316 /*     ----------------------- */
3317
3318 /*     DESCRIPTION/NOTES/LIMITATIONS : */
3319 /*     ----------------------------------- */
3320
3321
3322 /* > */
3323 /* ***********************************************************************
3324  */
3325 /*                      DECLARATIONS */
3326 /* ***********************************************************************
3327  */
3328
3329
3330 /* ***********************************************************************
3331  */
3332 /*                      PROCESSING */
3333 /* ***********************************************************************
3334  */
3335
3336     if (AdvApp2Var_SysBase::mnfndeb_() >= 1) {
3337         io___1.ciunit = AdvApp2Var_SysBase::mnfnimp_();
3338         //s__wsle(&io___1);
3339         //do__lio(&c__9, &c__1, "Dbg ", 4L);
3340         //do__lio(&c__9, &c__1, ctexte, ctexte_len);
3341         AdvApp2Var_SysBase::e__wsle();
3342     }
3343  return 0 ;
3344 } /* mswrdbg_ */
3345
3346
3347
3348 int __i__len()
3349 {
3350   return 0;
3351 }
3352
3353 int __s__cmp()
3354 {
3355   return 0;
3356 }
3357
3358 //=======================================================================
3359 //function : do__fio
3360 //purpose  : 
3361 //=======================================================================
3362 int AdvApp2Var_SysBase::do__fio() 
3363 {
3364 return 0;
3365 }
3366 //=======================================================================
3367 //function : do__lio
3368 //purpose  : 
3369 //=======================================================================
3370 int AdvApp2Var_SysBase::do__lio ()
3371 {
3372   return 0;
3373 }
3374 //=======================================================================
3375 //function : e__wsfe
3376 //purpose  : 
3377 //=======================================================================
3378 int AdvApp2Var_SysBase::e__wsfe ()
3379 {
3380   return 0;
3381 }
3382 //=======================================================================
3383 //function : e__wsle
3384 //purpose  : 
3385 //=======================================================================
3386 int AdvApp2Var_SysBase::e__wsle ()
3387 {
3388   return 0;
3389 }
3390 //=======================================================================
3391 //function : s__wsfe
3392 //purpose  : 
3393 //=======================================================================
3394 int AdvApp2Var_SysBase::s__wsfe ()
3395 {
3396   return 0;
3397 }
3398 //=======================================================================
3399 //function : s__wsle
3400 //purpose  : 
3401 //=======================================================================
3402 int AdvApp2Var_SysBase::s__wsle ()
3403 {
3404   return 0;
3405 }
3406
3407
3408 /*
3409 C*****************************************************************************
3410 C
3411 C     FUNCTION : CALL MVRIRAZ(NBELT,DTAB)
3412 C     ---------- 
3413 C     Reset to zero a table with DOUBLE PRECISION
3414 C
3415 C     KEYWORDS :
3416 C     -----------
3417 C     MVRMIRAZ DOUBLE
3418 C
3419 C     INPUT ARGUMENTS :
3420 C     ------------------
3421 C     NBELT  : Number of elements of the table
3422 C     DTAB   : Table to initializer to zero
3423 C
3424 C     OUTPUT ARGUMENTS :
3425 C     --------------------
3426 C     DTAB   : Table reset to zero
3427 C
3428 C     COMMONS USED  :
3429 C     ----------------
3430 C
3431 C     REFERENCES CALLED   :
3432 C     -----------------------
3433 C
3434 C     DEMSCRIPTION/NOTES/LIMITATIONS :
3435 C     -----------------------------------
3436 C     
3437 C
3438 C>
3439 C***********************************************************************
3440 */
3441 //=======================================================================
3442 //function : AdvApp2Var_SysBase::mvriraz_
3443 //purpose  : 
3444 //=======================================================================
3445 void AdvApp2Var_SysBase::mvriraz_(integer *taille,
3446                                   void *adt)
3447
3448 {
3449   integer offset;
3450   offset = *taille * 8 ;
3451   /*    printf(" adt %d  long %d\n",adt,offset); */
3452   memset(adt , '\0' , offset) ;
3453 }