// Copyright (c) 1999-2014 OPEN CASCADE SAS
//
// This file is part of Open CASCADE Technology software library.
//
// This library is free software; you can redistribute it and/or modify it under
// the terms of the GNU Lesser General Public License version 2.1 as published
// by the Free Software Foundation, with special exception defined in the file
// OCCT_LGPL_EXCEPTION.txt. Consult the file LICENSE_LGPL_21.txt included in OCCT
// distribution for complete text of the license and disclaimer of any warranty.
//
// Alternatively, this file may be used under the terms of Open CASCADE
// commercial license or contractual agreement.

// AdvApp2Var_SysBase.cxx
#include <assert.h>
#include <cmath>
#include <string.h>
#include <AdvApp2Var_SysBase.hxx>
#include <AdvApp2Var_Data.hxx>
#include <Standard.hxx>

static int __i__len();

static int __s__cmp();

static int macrbrk_();

static int macrclw_(intptr_t* iadfld, intptr_t* iadflf, integer* nalloc);
static int macrerr_(intptr_t* iad, intptr_t* nalloc);
static int macrgfl_(intptr_t* iadfld, intptr_t* iadflf, integer* iphase, integer* iznuti);
static int macrmsg_(const char* crout,
                    integer*    num,
                    integer*    it,
                    doublereal* xt,
                    const char* ct,
                    ftnlen      crout_len,
                    ftnlen      ct_len);

static int macrstw_(intptr_t* iadfld, intptr_t* iadflf, integer* nalloc);

static int madbtbk_(integer* indice);

static int magtlog_(const char* cnmlog,
                    const char* chaine,
                    integer*    long__,
                    integer*    iercod,
                    ftnlen      cnmlog_len,
                    ftnlen      chaine_len);

static int mamdlng_(char* cmdlng, ftnlen cmdlng_len);

static int maostrb_();

static int maostrd_();

static int maoverf_(integer* nbentr, doublereal* dtable);

static int matrlog_(const char* cnmlog,
                    const char* chaine,
                    integer*    length,
                    integer*    iercod,
                    ftnlen      cnmlog_len,
                    ftnlen      chaine_len);

static int matrsym_(const char* cnmsym,
                    const char* chaine,
                    integer*    length,
                    integer*    iercod,
                    ftnlen      cnmsym_len,
                    ftnlen      chaine_len);

static int mcrcomm_(integer* kop, integer* noct, intptr_t* iadr, integer* ier);

static int mcrfree_(integer* ibyte, intptr_t iadr, integer* ier);

static int mcrgetv_(integer* sz, intptr_t* iad, integer* ier);

static struct
{
  integer lec, imp, keyb, mae, jscrn, itblt, ibb;
} mblank__;

#define mcrfill_ABS(a) (((a) < 0) ? (-(a)) : (a))

//=================================================================================================

AdvApp2Var_SysBase::AdvApp2Var_SysBase()
{
  mainial_();
  memset(&mcrstac_, 0, sizeof(mcrstac_));
}

//=================================================================================================

AdvApp2Var_SysBase::~AdvApp2Var_SysBase()
{
  assert(mcrgene_.ncore == 0); // otherwise memory leaking
}

//=================================================================================================

int AdvApp2Var_SysBase::macinit_(integer* imode, integer* ival)

{

  /* ************************************************************************/
  /*     FUNCTION : */
  /*     ---------- */
  /*   INITIALIZATION OF READING WRITING UNITS AND 'IBB' */

  /*     KEYWORDS : */
  /*     ----------- */
  /*   MANAGEMENT, CONFIGURATION, UNITS, INITIALIZATION */

  /*     INPUT ARGUMENTS  : */
  /*     -------------------- */
  /*        IMODE : MODE of INITIALIZATION :
        0= DEFAULT, IMP IS 6, IBB 0 and LEC 5 */
  /*        1= FORCE VALUE OF IMP */
  /*        2= FORCE VALUE OF IBB */
  /*        3= FORCE VALUE OF LEC */

  /*    ARGUMENT USED ONLY WHEN IMODE IS 1 OR 2 : */
  /*       IVAL : VALUE OF IMP WHEN IMODE IS 1 */
  /*              VALUE OF IBB WHEN IMODE IS 2 */
  /*              VALUE OF LEC WHEN IMODE IS 3 */
  /*    THERE IS NO CONTROL OF VALIDITY OF VALUE OF IVAL . */

  /*     OUTPUT ARGUMENTS  : */
  /*     -------------------- */
  /*                NONE */

  /*     COMMONS USED : */
  /*     -------------- */
  /*     REFERENCES CALLED : */
  /*     ------------------- */
  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ------------------------------- */

  /*     THIS IS ONLY INITIALIZATION OF THE COMMON BLANK FOR ALL */
  /*     MODULES THAT A PRIORI DO NOT NEED TO KNOW THE COMMONS OF T . */
  /*     WHEN A MODIFICATION OF IBB IS REQUIRED (IMODE=2) AN INFO MESSAGE */
  /*     IS SUBMITTED ON IMP, WITH THE NEW VALUE OF IBB. */

  /*       IBB : MODE DEBUG OF STRIM T : RULES OF USE : */
  /*             0 RESTRAINED VERSION  */
  /*             >0 THE GREATER IS IBB THE MORE COMMENTS THE VERSION HAS. */
  /*                FOR EXAMPLE FOR IBB=1 THE ROUTINES CALLED */
  /*                INFORM ON IMP ('INPUT IN TOTO', */
  /*                AND 'OUTPUT FROM TOTO'), AND THE ROUTINES THAT RETURN */
  /*                NON NULL ERROR CODE INFORM IT AS WELL. */
  /*            (BUT IT IS NOT TRUE FOR ALL ROUTINES OF T) */
  /* > */
  /* ***********************************************************************
   */

  if (*imode == 0)
  {
    mblank__.imp = 6;
    mblank__.ibb = 0;
    mblank__.lec = 5;
  }
  else if (*imode == 1)
  {
    mblank__.imp = *ival;
  }
  else if (*imode == 2)
  {
    mblank__.ibb = *ival;
  }
  else if (*imode == 3)
  {
    mblank__.lec = *ival;
  }

  /* ----------------------------------------------------------------------*
   */

  return 0;
} /* macinit__ */

//=================================================================================================

int AdvApp2Var_SysBase::macrai4_(integer*  nbelem,
                                 integer*  maxelm,
                                 integer*  itablo,
                                 intptr_t* iofset,
                                 integer*  iercod)

{

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       Require dynamic allocation of type INTEGER */

  /*     KEYWORDS : */
  /*     ---------- */
  /*       SYSTEM, ALLOCATION, MEMORY, REALISATION */

  /*     INPUT ARGUMENTS : */
  /*     ----------------- */
  /*       NBELEM : Number of required units */
  /*       MAXELM : Max number of units available in ITABLO */
  /*       ITABLO : Reference Address of the rented zone */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------- */
  /*       IOFSET : Offset */
  /*       IERCOD : Error code */
  /*               = 0 : OK */
  /*               = 1 : Max nb of allocations attained */
  /*               = 2 : Incorrect arguments */
  /*               = 3 : Refused dynamic allocation */

  /*     COMMONS USED : */
  /*     ------------------ */

  /*     REFERENCES CALLED : */
  /*     --------------------- */
  /*        MCRRQST */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*     (Cf description in the heading of MCRRQST) */

  /*     Table ITABLO should be dimensioned to MAXELM by the caller. */
  /*     If the request is lower or equal to MAXELM, IOFSET becomes = 0.    */
  /*     Otherwise the demand of allocation is valid and IOFSET > 0. */
  /* > */
  /* ***********************************************************************
   */

  integer iunit;

  iunit = sizeof(integer);
  /* Function Body */
  if (*nbelem > *maxelm)
  {
    /*AdvApp2Var_SysBase::*/ mcrrqst_(&iunit, nbelem, itablo, iofset, iercod);
  }
  else
  {
    *iercod = 0;
    *iofset = 0;
  }
  return 0;
} /* macrai4_ */

//=================================================================================================

int AdvApp2Var_SysBase::macrar8_(integer*    nbelem,
                                 integer*    maxelm,
                                 doublereal* xtablo,
                                 intptr_t*   iofset,
                                 integer*    iercod)

{
  integer c__8 = 8;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       Demand of dynamic allocation of type DOUBLE PRECISION */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       SYSTEM, ALLOCATION, MEMORY, REALISATION */

  /*     INPUT ARGUMENTS  : */
  /*     ------------------ */
  /*       NBELEM : Nb of units required */
  /*       MAXELM : Max Nb of units available in XTABLO */
  /*       XTABLO : Reference address of the rented zone */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------ */
  /*       IOFSET : Offset */
  /*       IERCOD : Error code */
  /*               = 0 : OK */
  /*               = 1 : Max Nb of allocations reached */
  /*               = 2 : Arguments incorrect */
  /*               = 3 : Refuse of dynamic allocation */

  /*     COMMONS USED : */
  /*     ------------------ */

  /*     REFERENCES CALLED : */
  /*     --------------------- */
  /*        MCRRQST */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*     (Cf description in the heading of MCRRQST) */

  /*     Table XTABLO should be dimensioned to MAXELM by the caller. */
  /*     If the request is less or equal to MAXELM, IOFSET becomes = 0.    */
  /*     Otherwise the demand of allocation is valid and IOFSET > 0. */

  /* > */
  /* ***********************************************************************
   */

  /* Function Body */
  if (*nbelem > *maxelm)
  {
    /*AdvApp2Var_SysBase::*/ mcrrqst_(&c__8, nbelem, xtablo, iofset, iercod);
  }
  else
  {
    *iercod = 0;
    *iofset = 0;
  }
  return 0;
} /* macrar8_ */

//=================================================================================================

int macrbrk_()
{
  return 0;
} /* macrbrk_ */

//=================================================================================================

int AdvApp2Var_SysBase::macrchk_()
{
  /* System generated locals */
  integer i__1;

  /* Local variables */
  integer i__, j;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       CONTROL OF EXCESSES OF ALLOCATED MEMORY ZONE */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       SYSTEM, ALLOCATION, MEMORY, CONTROL, EXCESS */

  /*     INPUT ARGUMENTS : */
  /*     ----------------- */
  /*       NONE */

  /*     OUTPUT ARGUMENTS  : */
  /*     ------------------- */
  /*       NONE */

  /*     COMMONS USED : */
  /*     ------------------ */
  /*       MCRGENE */

  /*     REFERENCES CALLED : */
  /*     --------------------- */
  /*       MACRERR, MAOSTRD */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /* ***********************************************************************
   */

  /*     FONCTION : */
  /*     ---------- */
  /*        TABLE OF MANAGEMENT OF DYNAMIC MEMORY ALLOCATIONS */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        SYSTEM, MEMORY, ALLOCATION */

  /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
  /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
  /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
  /*         2 : UNIT OF ALLOCATION */
  /*         3 : NB OF ALLOCATED UNITS */
  /*         4 : REFERENCE ADDRESS OF THE TABLE */
  /*         5 : IOFSET */
  /*         6 : STATIC ALLOCATION NUMBER */
  /*         7 : Required allocation size */
  /*         8 : address of the beginning of allocation */
  /*         9 : Size of the USER ZONE */
  /*        10 : ADDRESS of the START FLAG */
  /*        11 : ADDRESS of the END FLAG */
  /*        12 : Rank of creation of the allocation */

  /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
  /*   NCORE : NB OF CURRENT ALLOCS */
  /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
  /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */

  /* ----------------------------------------------------------------------*
   */

  /* ----------------------------------------------------------------------*
   */

  /* CONTROL OF FLAGS IN THE TABLE */
  i__1 = mcrgene_.ncore;
  for (i__ = 0; i__ < i__1; ++i__)
  {

    // p to access startaddr and endaddr
    intptr_t* p = &mcrgene_.icore[i__].startaddr;
    for (j = 0; j <= 1; ++j)
    {
      intptr_t* pp = p + j;
      if (*pp != -1)
      {

        double* t = reinterpret_cast<double*>(*pp);
        if (*t != -134744073.)
        {
          /* MSG : '*** ERREUR  : REMOVAL FROM MEMORY OF ADDRESS
             E:',ICORE(J,I) */
          /*       AND OF RANK ICORE(12,I) */
          macrerr_(pp, p + 2);

          /* BACK-PARCING IN PHASE OF PRODUCTION */
          maostrb_();

          /* REMOVAL OF THE ADDRESS OF FLAG TO AVOID REMAKING ITS CONTROL */
          *pp = -1;
        }
      }

      /* L100: */
    }

    /* L1000: */
  }
  return 0;
} /* macrchk_ */

//=================================================================================================

int macrclw_(intptr_t*, // iadfld,
             intptr_t*, // iadflf,
             integer*)  // nalloc)

{
  return 0;
} /* macrclw_ */

//=================================================================================================

int AdvApp2Var_SysBase::macrdi4_(integer* nbelem,
                                 integer*, // maxelm,
                                 integer*  itablo,
                                 intptr_t* iofset, /* Offset long (pmn) */
                                 integer*  iercod)

{

  /* ***********************************************************************
   */

  /*     FuNCTION : */
  /*     ---------- */
  /*       Destruction of dynamic allocation of type INTEGER */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       SYSTEM, ALLOCATION, MEMORY, DESTRUCTION */

  /*     INPUT ARGUMENTS  : */
  /*     ------------------ */
  /*       NBELEM : Nb of units required */
  /*       MAXELM : Max Nb of units available in ITABLO */
  /*       ITABLO : Reference Address of the allocated zone */
  /*       IOFSET : Offset */

  /*     OUTPUT ARGUMENTS : */
  /*     --------------------- */
  /*       IERCOD : Error Code */
  /*               = 0 : OK */
  /*               = 1 : Pb of de-allocation of a zone allocated in table */
  /*               = 2 : The system refuses the demand of de-allocation */

  /*     COMMONS USED : */
  /*     ------------------ */

  /*     REFERENCES CALLED : */
  /*     --------------------- */
  /*        MCRDELT */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*     (Cf description in the heading of MCRDELT) */
  /* > */
  /* ***********************************************************************
   */
  integer iunit;

  iunit = sizeof(integer);
  /* Function Body */
  if (*iofset != 0)
  {
    AdvApp2Var_SysBase::mcrdelt_(&iunit, nbelem, itablo, iofset, iercod);
  }
  else
  {
    *iercod = 0;
  }
  return 0;
} /* macrdi4_ */

//=================================================================================================

int AdvApp2Var_SysBase::macrdr8_(integer* nbelem,
                                 integer*, // maxelm,
                                 doublereal* xtablo,
                                 intptr_t*   iofset,
                                 integer*    iercod)

{
  integer c__8 = 8;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       Destruction of dynamic allocation of type DOUBLE PRECISION
   */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       SYSTEM, ALLOCATION, MEMORY, DESTRUCTION */

  /*     INPUT ARGUMENTS : */
  /*     -------------------- */
  /*       NBELEM : Nb of units required */
  /*       MAXELM : Max nb of units available in XTABLO */
  /*       XTABLO : Reference Address of the allocated zone */
  /*       IOFSET : Offset */

  /*     OUTPUT ARGUMENTS  : */
  /*     ------------------- */
  /*       IERCOD : Error Code */
  /*               = 0 : OK */
  /*               = 1 : Pb of de-allocation of a zone allocated on table */
  /*               = 2 : The system refuses the demand of de-allocation */

  /*     COMMONS USED : */
  /*     -------------- */

  /*     REFERENCES CALLEDS : */
  /*     -------------------- */
  /*        MCRDELT */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*     (Cf description in the heading of MCRDELT) */

  /* > */
  /* ***********************************************************************
   */

  /* Function Body */
  if (*iofset != 0)
  {
    AdvApp2Var_SysBase::mcrdelt_(&c__8, nbelem, xtablo, iofset, iercod);
  }
  else
  {
    *iercod = 0;
  }
  return 0;
} /* macrdr8_ */

//=================================================================================================

int macrerr_(intptr_t*, // iad,
             intptr_t*) // nalloc)

{
  // integer c__1 = 1;
  /* Builtin functions */
  // integer /*do__fio(),*/;

  /* Fortran I/O blocks */
  // cilist io___1 = { 0, 6, 0, "(X,A,I9,A,I3)", 0 };

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       WRITING OF ADDRESS REMOVED IN ALLOCS . */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       ALLOC CONTROL */

  /*     INPUT ARGUMENTS  : */
  /*     ------------------ */
  /*       IAD    : ADDRESS TO INFORM OF REMOVAL */
  /*       NALLOC : NUMBER OF ALLOCATION */

  /*     OUTPUT ARGUMENTS : */
  /*     --------------------- */
  /*       NONE */

  /*     COMMONS USED : */
  /*     -------------- */

  /*     REFERENCES CALLED : */
  /*     ------------------- */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /* > */
  /* ***********************************************************************
   */
  /*
  do__fio(&c__1, "*** ERREUR : Ecrasement de la memoire d'adresse ", 48L);
  do__fio(&c__1, (char *)&(*iad), (ftnlen)sizeof(long int));
  do__fio(&c__1, " sur l'allocation ", 18L);
  do__fio(&c__1, (char *)&(*nalloc), (ftnlen)sizeof(integer));
  */

  return 0;
} /* macrerr_ */

//=================================================================================================

int macrgfl_(intptr_t* iadfld, intptr_t* iadflf, integer* iphase, integer* iznuti)

{
  /* Initialized data */

  /* original code used static integer ifois=0 which served as static
     initialization flag and was only used to call matrsym_() once; now
     this flag is not used as matrsym_() always returns 0 and has no
     useful contents
  */
  integer ifois = 1;

  char    cbid[1] = {};
  integer ibid, ienr;
  integer novfl = 0;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       IMPLEMENTATION OF TWO FLAGS START AND END OF THE ALLOCATED ZONE */
  /*       AND SETTING TO OVERFLOW OF THE USER SPACE IN PHASE OF PRODUCTION. */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       ALLOCATION, CONTROL, EXCESS */

  /*     INPUT ARGUMENTS  : */
  /*     ------------------ */
  /*       IADFLD : ADDRESS OF THE START FLAG */
  /*       IADFLF : ADDRESS OF THE END FLAG */
  /*       IPHASE : TYPE OF SOFTWARE VERSION : */
  /*                0 = OFFICIAL VERSION  */
  /*                1 = PRODUCTION VERSION */
  /*       IZNUTI : SIZE OF THE USER ZONE IN OCTETS */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------ */
  /*       NONE */

  /*     COMMONS USED : */
  /*     ------------------ */

  /*     REFERENCES CALLED : */
  /*     ------------------- */
  /*       CRLOCT,MACRCHK */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*        TABLE FOR MANAGEMENT OF DYNAMIC ALLOCATIONS OF MEMORY */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        SYSTEM, MEMORY, ALLOCATION */

  /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */
  /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
  /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
  /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
  /*         2 : UNIT OF ALLOCATION */
  /*         3 : NB OF ALLOCATED UNITS */
  /*         4 : REFERENCE ADDRESS OF THE TABLE */
  /*         5 : IOFSET */
  /*         6 : STATIC ALLOCATION NUMBER */
  /*         7 : Required allocation size */
  /*         8 : address of the beginning of allocation */
  /*         9 : Size of the USER ZONE */
  /*        10 : ADDRESS of the START FLAG */
  /*        11 : ADDRESS of the END FLAG */
  /*        12 : Rank of creation of the allocation */

  /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
  /*   NCORE : NB OF CURRENT ALLOCS */
  /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
  /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */

  /* ----------------------------------------------------------------------*
   */

  if (ifois == 0)
  {
    matrsym_("NO_OVERFLOW", cbid, &novfl, &ibid, 11L, 1L);
    ifois = 1;
  }

  /* CALCULATE THE OFFSET */
  double* t = reinterpret_cast<double*>(*iadfld);

  /*  SET TO OVERFLOW OF THE USER ZONE IN CASE OF PRODUCTION VERSION */
  if (*iphase == 1 && novfl == 0)
  {
    ienr = *iznuti / 8;
    maoverf_(&ienr, &t[1]);
  }

  /*  UPDATE THE START FLAG */
  *t = -134744073.;

  /*  FAKE CALL TO STOP THE DEBUGGER : */
  macrbrk_();

  /*  UPDATE THE START FLAG */
  t  = reinterpret_cast<double*>(*iadflf);
  *t = -134744073.;

  /*  FAKE CALL TO STOP THE DEBUGGER : */
  macrbrk_();

  return 0;
} /* macrgfl_ */

//=================================================================================================

int macrmsg_(const char*, // crout,
             integer*,    // num,
             integer*    it,
             doublereal* xt,
             const char* ct,
             ftnlen, // crout_len,
             ftnlen ct_len)

{

  /* Local variables */
  integer           inum;
  char /*cfm[80],*/ cln[3];

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*        MESSAGING OF ROUTINES OF ALLOCATION */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       ALLOC, MESSAGE */

  /*     INPUT ARGUMENTSEE : */
  /*     ------------------- */
  /*       CROUT : NAME OF THE CALLING ROUTINE : MCRRQST, MCRDELT, MCRLIST
   */
  /*                ,CRINCR OR CRPROT */
  /*       NUM :  MESSAGE NUMBER */
  /*       IT : TABLE OF INTEGER DATA */
  /*       XT : TABLE OF REAL DATA */
  /*       CT : ------------------ CHARACTER */

  /*     OUTPUT ARGUMENTS : */
  /*     --------------------- */
  /*       NONE */

  /*     COMMONS USED : */
  /*     ------------------ */

  /*     REFERENCES CALLED : */
  /*     --------------------- */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /*   ROUTINE FOR TEMPORARY USE, WAITING FOR THE 'NEW' MESSAGE */
  /*    (STRIM 3.3 ?), TO MAKE THE ROUTINES OF ALLOC USABLE */
  /*    IN STRIM T-M . */

  /*   DEPENDING ON THE LANGUAGE, WRITING OF THE REQUIRED MESSAGE ON */
  /*   UNIT IMP . */
  /*   (REUSE OF SPECIFS OF VFORMA) */

  /*   THE MESSAGE IS INITIALIZED AT 'MESSAGE MISSING', AND IT IS */
  /*   REPLACED BY THE REQUIRED MESSAGE IF EXISTS. */
  /* > */
  /* ***********************************************************************
   */

  /*  LOCAL : */

  /* ----------------------------------------------------------------------*
   */
  /*  FIND MESSAGE DEPENDING ON THE LANGUAGE , THE ROUTINE */
  /*  AND THE MESSAGE NUMBER */

  /*  READING OF THE LANGUAGE : */
  /* Parameter adjustments */
  ct -= ct_len;
  (void)ct; // unused
  (void)xt; // unused
  (void)it; // unused

  /* Function Body */
  mamdlng_(cln, 3L);

  /*  INUM : TYPE OF MESSAGE  : 0 AS TEXT, 1 1 INTEGER TO BE WRITTEN */
  /*        -1 MESSAGE INEXISTING (1 INTEGER AND 1 CHAIN) */

  inum = -1;
  /*
    if (__s__cmp(cln, "FRA", 3L, 3L) == 0) {
      __s__copy(cfm, "('   Il manque le message numero ',I5' pour le programm\
  e de nom : ',A8)", 80L, 71L);
      if (__s__cmp(crout, "MCRLIST", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(/,' Nombre d''allocation(s) de memoire effectu\
  ee(s) : ',I6,/)", 80L, 62L);
        } else if (*num == 2) {
      inum = 1;
      __s__copy(cfm, "(' Taille de l''allocation = ',I12)", 80L, 35L);
        } else if (*num == 3) {
      inum = 1;
      __s__copy(cfm, "(' Taille totale allouee  = ',I12 /)", 80L, 36L);
        }
      } else if (__s__cmp(crout, "MCRDELT", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 0;
      __s__copy(cfm, "(' L''allocation de memoire a detruire n''exist\
  e pas  ')", 80L, 56L);
        } else if (*num == 2) {
      inum = 0;
      __s__copy(cfm, "(' Le systeme refuse une destruction d''allocat\
  ion de memoire  ')", 80L, 65L);
        }
      } else if (__s__cmp(crout, "MCRRQST", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(' Le nombre maxi d''allocations de memoire est\
   atteint :',I6)", 80L, 62L);
        } else if (*num == 2) {
      inum = 1;
      __s__copy(cfm, "(' Unite d''allocation invalide : ',I12)", 80L,
            40L);
        } else if (*num == 3) {
      inum = 1;
      __s__copy(cfm, "(' Le systeme refuse une allocation de memoire \
  de ',I12,' octets')", 80L, 66L);
        }
      } else if (__s__cmp(crout, "CRINCR", crout_len, 6L) == 0) {
        if (*num == 1) {
      inum = 0;
      __s__copy(cfm, "(' L''allocation de memoire a incrementer n''ex\
  iste pas')", 80L, 57L);
        }
      } else if (__s__cmp(crout, "CRPROT", crout_len, 6L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(' Le niveau de protection est invalide ( =< 0 \
  ) : ',I12)", 80L, 57L);
        }
      }

    } else if (__s__cmp(cln, "DEU", 3L, 3L) == 0) {
      __s__copy(cfm, "('   Es fehlt die Meldung Nummer ',I5,' fuer das Progra\
  mm des Namens : ',A8)", 80L, 76L);
      if (__s__cmp(crout, "MCRLIST", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(/,' Anzahl der ausgefuehrten dynamischen Anwei\
  sung(en) : ',I6,/)", 80L, 65L);
        } else if (*num == 2) {
      inum = 1;
      __s__copy(cfm, "(' Groesse der Zuweisung = ',I12)", 80L, 33L);
        } else if (*num == 3) {
      inum = 1;
      __s__copy(cfm, "(' Gesamtgroesse der Zuweisung = ',I12,/)", 80L,
            41L);
        }
      } else if (__s__cmp(crout, "MCRDELT", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 0;
      __s__copy(cfm, "(' Zu loeschende dynamische Zuweisung existiert\
   nicht !! ')", 80L, 59L);
        } else if (*num == 2) {
      inum = 0;
      __s__copy(cfm, "(' System verweigert Loeschung der dynamischen \
  Zuweisung !!')", 80L, 61L);
        }
      } else if (__s__cmp(crout, "MCRRQST", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(' Hoechstzahl dynamischer Zuweisungen ist erre\
  icht :',I6)", 80L, 58L);
        } else if (*num == 2) {
      inum = 1;
      __s__copy(cfm, "(' Falsche Zuweisungseinheit : ',I12)", 80L, 37L)
        ;
        } else if (*num == 3) {
      inum = 1;
      __s__copy(cfm, "(' System verweigert dynamische Zuweisung von '\
  ,I12,' Bytes')", 80L, 61L);
        }
      } else if (__s__cmp(crout, "CRINCR", crout_len, 6L) == 0) {
        if (*num == 1) {
      inum = 0;
      __s__copy(cfm, "(' Zu inkrementierende dynamische Zuweisung exi\
  stiert nicht !! ')", 80L, 65L);
        }
      } else if (__s__cmp(crout, "CRPROT", crout_len, 6L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(' Sicherungsniveau ist nicht richtig ( =< 0 ) \
  : ',I12)", 80L, 55L);
        }
      }

    } else {
      __s__copy(cfm, "('   Message number ',I5,' is missing '                \
              ,'for program named: ',A8)", 80L, 93L);
      if (__s__cmp(crout, "MCRLIST", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(/,' number of memory allocations carried out: \
  ',I6,/)", 80L, 54L);
        } else if (*num == 2) {
      inum = 1;
      __s__copy(cfm, "(' size of allocation = ',I12)", 80L, 30L);
        } else if (*num == 3) {
      inum = 1;
      __s__copy(cfm, "(' total size allocated = ',I12,/)", 80L, 34L);
        }
      } else if (__s__cmp(crout, "MCRDELT", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 0;
      __s__copy(cfm, "(' Memory allocation to delete does not exist !\
  ! ')", 80L, 51L);
        } else if (*num == 2) {
      inum = 0;
      __s__copy(cfm, "(' System refuses deletion of memory allocation\
   !! ')", 80L, 53L);
        }
      } else if (__s__cmp(crout, "MCRRQST", crout_len, 7L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(' max number of memory allocations reached :',\
  I6)", 80L, 50L);
        } else if (*num == 2) {
      inum = 1;
      __s__copy(cfm, "(' incorrect unit of allocation : ',I12)", 80L,
            40L);
        } else if (*num == 3) {
      inum = 1;
      __s__copy(cfm, "(' system refuses a memory allocation of ',I12,\
  ' bytes ')", 80L, 57L);
        }
      } else if (__s__cmp(crout, "CRINCR", crout_len, 6L) == 0) {
        if (*num == 1) {
      inum = 0;
      __s__copy(cfm, "(' Memory allocation to increment does not exis\
  t !! ')", 80L, 54L);
        }
      } else if (__s__cmp(crout, "CRPROT", crout_len, 6L) == 0) {
        if (*num == 1) {
      inum = 1;
      __s__copy(cfm, "(' level of protection is incorrect ( =< 0 ) : \
  ',I12)", 80L, 53L);
        }
      }
    }
    */
  /* ----------------------------------------------------------------------*
   */
  /*  iMPLEMENTATION OF WRITE , WITH OR WITHOUT DATA : */

  if (inum == 0)
  {
  }
  else if (inum == 1)
  {
    /*
    do__fio(&c__1, (char *)&it[1], (ftnlen)sizeof(integer));
    */
  }
  else
  {
    /*  MESSAGE DOES NOT EXIST ... */
    /*
    do__fio(&c__1, (char *)&(*num), (ftnlen)sizeof(integer));
    do__fio(&c__1, crout, crout_len);
    */
  }

  return 0;
} /* macrmsg_ */

//=================================================================================================

int macrstw_(intptr_t*, // iadfld,
             intptr_t*, // iadflf,
             integer*)  // nalloc)

{
  return 0;
} /* macrstw_ */

//=================================================================================================

int madbtbk_(integer* indice)
{
  *indice = 0;
  return 0;
} /* madbtbk_ */

//=================================================================================================

int AdvApp2Var_SysBase::maermsg_(const char*, // cnompg,
                                 integer*,    // icoder,
                                 ftnlen)      // cnompg_len)

{
  return 0;
} /* maermsg_ */

//=================================================================================================

int magtlog_(const char* cnmlog,
             const char*, // chaine,
             integer* long__,
             integer* iercod,
             ftnlen   cnmlog_len,
             ftnlen) // chaine_len)

{

  /* Local variables */
  char    cbid[255];
  integer ibid, ier;

  /* **********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*        RETURN TRANSLATION OF "NAME LOGIC STRIM" IN */
  /*        "INTERNAL SYNTAX" CORRESPONDING TO "PLACE OF RANKING" */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        NOM LOGIQUE STRIM , TRADUCTION */

  /*     INPUT ARGUMENTS : */
  /*     ------------------ */
  /*        CNMLOG : NAME OF "NAME LOGIC STRIM" TO TRANSLATE */

  /*     OUTPUT ARGUMENTS  : */
  /*     ------------------- */
  /*        CHAINE : ADDRESS OF "PLACE OF RANKING" */
  /*        LONG   : USEFUL LENGTH OF "PLACE OF RANKING" */
  /*        IERCOD : ERROR CODE */
  /*        IERCOD = 0 : OK */
  /*        IERCOD = 5 : PLACE OF RANKING CORRESPONDING TO INEXISTING LOGIC NAME */

  /*        IERCOD = 6 : TRANSLATION TOO LONG FOR THE 'CHAIN' VARIABLE */
  /*        IERCOD = 7 : CRITICAL ERROR */

  /*     COMMONS USED   : */
  /*     ---------------- */
  /*        NONE */

  /*     REFERENCES CALLED   : */
  /*     --------------------- */
  /*        GNMLOG, MACHDIM */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ------------------------------- */

  /*        SPECIFIC SGI ROUTINE */

  /*        IN ALL CASES WHEN IERCOD IS >0, NO RESULT IS RETURNED*/
  /*        NOTION OF  "USER SYNTAX' AND "INTERNAL SYNTAX" */
  /*        --------------------------------------------------- */

  /*       THE "USER SYNTAX" IS THE SYNTAX WHERE THE USER*/
  /*       VISUALIZES OR INDICATES THE FILE OR DIRECTORY NAME */
  /*       DURING A SESSION OF STRIM100 */

  /*        "INTERNAL SYNTAX" IS SYNTAX USED TO CARRY OUT */
  /*        OPERATIONS OF FILE PROCESSING INSIDE THE CODE */
  /*        (OPEN,INQUIRE,...ETC) */

  /* > */
  /* ***********************************************************************
   */
  /*              DECLARATIONS */
  /* ***********************************************************************
   */

  /* ***********************************************************************
   */
  /*              PROCESSING */
  /* ***********************************************************************
   */

  *long__ = 0;
  *iercod = 0;

  /* CONTROL OF EXISTENCE OF THE LOGIC NAME */

  matrlog_(cnmlog, cbid, &ibid, &ier, cnmlog_len, 255L);
  if (ier == 1)
  {
    goto L9500;
  }
  if (ier == 2)
  {
    goto L9700;
  }

  /* CONTROL OF THE LENGTH OF CHAIN */

  if (ibid > __i__len() /*chaine, chaine_len)*/)
  {
    goto L9600;
  }

  //__s__copy(chaine, cbid, chaine_len, ibid);
  *long__ = ibid;

  goto L9999;

  /* ***********************************************************************
   */
  /*              ERROR PROCESSING */
  /* ***********************************************************************
   */

L9500:
  *iercod = 5;
  //__s__copy(chaine, " ", chaine_len, 1L);
  goto L9999;

L9600:
  *iercod = 6;
  //__s__copy(chaine, " ", chaine_len, 1L);
  goto L9999;

L9700:
  *iercod = 7;
  //__s__copy(chaine, " ", chaine_len, 1L);

  /* ***********************************************************************
   */
  /*              RETURN TO THE CALLING PROGRAM */
  /* ***********************************************************************
   */

L9999:
  return 0;
} /* magtlog_ */

//=================================================================================================

int AdvApp2Var_SysBase::mainial_()
{
  mcrgene_.ncore = 0;
  mcrgene_.lprot = 0;
  return 0;
} /* mainial_ */

//=================================================================================================

int AdvApp2Var_SysBase::maitbr8_(integer* itaill, doublereal* xtab, doublereal* xval)

{
  integer c__504 = 504;

  /* Initialized data */

  doublereal buff0[63] = {0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
                          0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
                          0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.,
                          0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0., 0.};

  /* System generated locals */
  integer i__1;

  /* Local variables */
  integer    i__;
  doublereal buffx[63];
  integer    nbfois, noffst, nreste, nufois;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       INITIALIZATION TO A GIVEN VALUE OF A TABLE OF REAL *8 */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       MANIPULATIONS, MEMORY, INITIALIZATION, DOUBLE-PRECISION */

  /*     INPUT ARGUMENTS : */
  /*     ----------------- */
  /*        ITAILL : SIZE OF THE TABLE */
  /*        XTAB   : TABLE TO INITIALIZE WITH XVAL */
  /*        XVAL   : VALUE TO SET IN XTAB(FROM 1 TO ITAILL) */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------ */
  /*        XTAB   : INITIALIZED TABLE */

  /*     COMMONS USED : */
  /*     -------------- */

  /*     REFERENCES CALLED : */
  /*     ------------------- */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /*   ONE CALLS MCRFILL WHICH MOVES BY PACKS OF 63 REALS */

  /*   THE INITIAL PACK IS BUFF0 INITIATED BY DATA IF THE VALUE IS 0 */
  /*   OR OTHERWISE BUFFX INITIATED BY XVAL (LOOP). */

  /*   PORTABILITY : YES */
  /*   ACCESS : FREE */

  /* > */
  /* ***********************************************************************
   */

  /* Parameter adjustments */
  --xtab;

  /* Function Body */

  /* ----------------------------------------------------------------------*
   */

  nbfois = *itaill / 63;
  noffst = nbfois * 63;
  nreste = *itaill - noffst;

  if (*xval == 0.)
  {
    if (nbfois >= 1)
    {
      i__1 = nbfois;
      for (nufois = 1; nufois <= i__1; ++nufois)
      {
        AdvApp2Var_SysBase::mcrfill_(&c__504, buff0, &xtab[(nufois - 1) * 63 + 1]);
        /* L1000: */
      }
    }

    if (nreste >= 1)
    {
      i__1 = nreste << 3;
      AdvApp2Var_SysBase::mcrfill_(&i__1, buff0, &xtab[noffst + 1]);
    }
  }
  else
  {
    for (i__ = 1; i__ <= 63; ++i__)
    {
      buffx[i__ - 1] = *xval;
      /* L2000: */
    }
    if (nbfois >= 1)
    {
      i__1 = nbfois;
      for (nufois = 1; nufois <= i__1; ++nufois)
      {
        AdvApp2Var_SysBase::mcrfill_(&c__504, buffx, &xtab[(nufois - 1) * 63 + 1]);
        /* L3000: */
      }
    }

    if (nreste >= 1)
    {
      i__1 = nreste << 3;
      AdvApp2Var_SysBase::mcrfill_(&i__1, buffx, &xtab[noffst + 1]);
    }
  }

  /* ----------------------------------------------------------------------*
   */

  return 0;
} /* maitbr8_ */

//=================================================================================================

int mamdlng_(char*,  // cmdlng,
             ftnlen) // cmdlng_len)

{

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*   RETURN THE CURRENT LANGUAGE */

  /*     KEYWORDS : */
  /*     ----------- */
  /*   MANAGEMENT, CONFIGURATION, LANGUAGE, READING */

  /*     INPUT ARGUMENTS : */
  /*     -------------------- */
  /*       CMDLNG : LANGUAGE */

  /*     OUTPUT ARGUMENTS  : */
  /*     ------------------- */
  /*       NONE */

  /*     COMMONS USED : */
  /*     ------------------ */
  /*       MACETAT */

  /*     REFERENCES CALLED : */
  /*     --------------------- */
  /*       NONE */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*       RIGHT OF USAGE : ANY APPLICATION */

  /*       ATTENTION : THIS ROUTINE DEPENDS ON PRELIMINARY INITIALISATION */
  /*       ----------  WITH AMDGEN. */
  /*                   SO IT IS ENOUGH TO PROVIDE THAT THIS INIT IS */
  /*                   CORRECTLY IMPLEMENTED IN THE RESPECTIVE PROGRAMS */
  /* > */
  /* ***********************************************************************
   */

  /*     INCLUDE MACETAT */
  /* < */

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*        CONTAINS INFORMATION ABOUT THE COMPOSITION OF */
  /*        THE EXECUTABLE AND ITS ENVIRONMENT : */
  /*        - LANGUAGES */
  /*        - PRESENT APPLICATIONS */
  /*        - AUTHORIZED TYPES OF ENTITIES (NON USED) */
  /*        AND INFORMATION DESCRIBING THE CURRENT STATE : */
  /*        - CURRENT APPLICATION */
  /*        - MODE OF USAGE (NOT USED) */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        APPLICATION, LANGUAGE */

  /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /*     A) CHLANG*4 : LIST OF POSSIBLE VALUES OF THE LANGUAGE : */
  /*                   'FRA ','DEU ','ENG ' */

  /*        CHL10N*4 : LIST OF POSSIBLE VALUES OF THE LOCALIZATION : */
  /*                   'FRA ','DEU ','ENG ', 'JIS ' */

  /*     B) CHCOUR*4, CHPREC*4, CHSUIV*4 : CURRENT, PREVIOUS AND NEXT APPLICATION */

  /*     C) CHMODE*4 : CURRENT MODE (NOT USED) */

  /*     D) CHPRES*2 (1:NBRMOD) : LIST OF APPLICATIONS TAKEN INTO ACCOUNT */

  /*       Rang ! Code interne  !   Application */
  /*       ---------------------------------------------------------- */
  /*        1   !   CD          !   Modeling 2D */
  /*        2   !   CA          !   Modeling 2D by learning */
  /*        3   !   CP          !   Parameterized 2D modelization */
  /*        4   !   PC          !   Rheological 2D modelization */
  /*        5   !   CU          !   Milling 2 Axes 1/2 */
  /*        6   !   CT          !   Turning */
  /*        7   !   TS          !   3D surface modeling */
  /*        8   !   TV          !   3D volume modeling */
  /*        9   !   MC          !   Surface Meshing */
  /*        10  !   MV          !   Volume Meshing */
  /*        11  !   TU          !   Machining by 3 axes */
  /*        12  !   T5          !   Machining by 3-5 axes */
  /*        13  !   TR          !   Machinning by 5 axes of regular surfaces */
  /*        14  !   IG          !   Interface IGES */
  /*        15  !   ST          !   Interface SET */
  /*        16  !   VD          !   Interface VDA */
  /*        17  !   IM          !   Interface of modeling */
  /*        18  !   GA          !   Generator APT/IFAPT */
  /*        19  !   GC          !   Generator COMPACT II */
  /*        20  !   GP          !   Generator PROMO */
  /*        21  !   TN          !   Machining by numerical copying */
  /*        22  !   GM          !   Management of models */
  /*        23  !   GT          !   Management of trace */
  /*       ---------------------------------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /*     NUMBER OF APPLICATIONS TAKEN INTO ACCOUNT */

  /*     NUMBER OF ENTITY TYPES MANAGED BY STRIM 100 */
  //__s__copy(cmdlng, macetat_.chlang, cmdlng_len, 4L);

  return 0;
} /* mamdlng_ */

//=================================================================================================

int maostrb_()
{
  return 0;
} /* maostrb_ */

//=================================================================================================

int maostrd_()
{
  integer imod;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       REFINE TRACE-BACK IN PRODUCTION PHASE */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       FUNCTION, SYSTEM, TRACE-BACK, REFINING, DEBUG */

  /*     INPUT ARGUMENTS : */
  /*     ----------------- */
  /*       NONE */

  /*     OUTPUT ARGUMENTS E : */
  /*     -------------------- */
  /*        NONE */

  /*     COMMONS USED : */
  /*     -------------- */
  /*        NONE */

  /*     REFERENCES CALLED : */
  /*     ------------------- */
  /*       MADBTBK */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*       THIS ROUTINE SHOULD BE CALLED TO REFINE */
  /*       TRACE-BACK IN PRODUCTION PHASE AND LEAVE TO TESTERS THE  */
  /*       POSSIBILITY TO GET TRACE-BACK IN */
  /*       CLIENT VERSIONS IF ONE OF THE FOLLOWING CONDITIONS IS */
  /*       VERIFIED : */
  /*       - EXISTENCE OF SYMBOL 'STRMTRBK' */
  /*       - EXISTENCE OF FILE 'STRMINIT:STRMTRBK.DAT' */

  /* > */
  /* ***********************************************************************
   */
  madbtbk_(&imod);
  if (imod == 1)
  {
    maostrb_();
  }
  return 0;
} /* maostrd_ */

//=================================================================================================

int maoverf_(integer* nbentr, doublereal* dtable)

{
  /* Initialized data */

  integer ifois = 0;

  /* System generated locals */
  integer i__1;

  /* Local variables */
  integer    ibid;
  doublereal buff[63];
  integer    ioct, indic, nrest, icompt;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       Initialisation in overflow of a tableau with DOUBLE PRECISION */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       MANIPULATION, MEMORY, INITIALISATION, OVERFLOW */

  /*     INPUT ARGUMENTS : */
  /*     ----------------- */
  /*       NBENTR : Number of entries in the table */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------ */
  /*       DATBLE : Table double precision initialized in overflow */

  /*     COMMONS USED : */
  /*     ------------------ */
  /*       R8OVR contained in the include MAOVPAR.INC */

  /*     REFERENCES CALLED : */
  /*     --------------------- */
  /*       MCRFILL */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*       1) Doc. programmer : */

  /*       This routine initialized to positive overflow a table with */
  /*       DOUBLE PRECISION. */

  /*       Other types of tables (INTEGER*2, INTEGER, REAL, ...) */
  /*       are not managed by the routine. */

  /*       It is usable in phase of development to detect the */
  /*       errors of initialization. */

  /*       In official version, these calls will be inactive. */

  /*       ACCESs : Agreed with AC. */

  /*       The routine does not return error code. */

  /*       Argument NBELEM should be positive. */
  /*       If it is negative or null, display message "MAOVERF : NBELEM = */
  /*       valeur_de_NBELEM" and a Trace Back by the call of routine MAOSTRB. */

  /*       2) Doc. designer  : */

  /*                  The idea is to minimize the number of calls */
  /*                to the routine of transfer of numeric zones, */
  /*   ----------   for the reason of performance. */
  /*  !  buffer  !    For this a table of NLONGR */
  /*  !__________!  DOUBLE PRECISIONs is reserved. This buffer is initialized by */
  /*  <---------->  the instruction DATA. The overflow is accessed in a  */
  /*    NLONGR*8    specific COMMON not by a routine as */
  /*                the initialisation is done by DATA. */

  /*                * If NBENTR<NLONGR, a part of the buffer is transferred*/
  /*     DTABLE     in DTABLE. */
  /*   __________ */
  /*  !  amorce  !  * Otherwise, the entire buffer is transferred in DTABLE. */
  /*  !__________!  This initiates it. Then a loop is execute, which at each
   */
  /*  !  temps 1 !  iteration transfers the part of the already initialized table */
  /*  !__________!  in the one that was not yet initialized. */
  /*  !          !  The size of the zone transferred by each call to MCRFILL
   */
  /*  !  temps 2 !  is NLONGR*2**(numero_de_l'iteration). When
   */
  /*  !          !  the size of the table to be initialized is */
  /*  !__________!  less than the already initialized size, the loop is */
  /*  !          !  abandoned and thev last transfer is carried out to */
  /*  !          !  initialize the remaining table, except for the case when the size */
  /*  !          !  of the table is of type NLONGR*2**K. */
  /*  !  temps 3 ! */
  /*  !          !  * NLONGR will be equal to 19200. */
  /*  !          ! */
  /*  !          ! */
  /*  !__________! */
  /*  !  reste   ! */
  /*  !__________! */

  /* > */
  /* ***********************************************************************
   */

  /* Inclusion of MAOVPAR.INC */

  /*      CONSTANTS */
  /*     INCLUDE MAOVPAR */
  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       DEFINES SPECIFIC LIMITED VALUES. */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       SYSTEM, LIMITS, VALUES, SPECIFIC */

  /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*     *** THEY CAN'T BE REMOVED DURING EXECUTION. */

  /*     *** THE VALUES OF UNDERFLOW AND OVERFLOW CAN'T BE  */
  /*     DEFINED IN DECIMAL VALUES (ERROR OF COMPILATION D_FLOAT) */
  /*     THEY ARE DEFINED AS HEXADECIMAL VALUES */

  /* > */
  /* ***********************************************************************
   */

  /*    DECLARATION OF THE COMMON FOR NUMERIC TYPES */

  /*    DECLARATION OF THE COMMON FOR CHARACTER TYPES*/

  /*      LOCAL VARIABLES */

  /*      TABLES */

  /*      DATA */
  /* Parameter adjustments */
  --dtable;

  /* Function Body */

  /* vJMB R8OVR IS NOT YET initialized, so impossible to use DATA
   */
  /*         DATA BUFF / NLONGR * R8OVR / */

  /*    init of BUFF is done only once */

  if (ifois == 0)
  {
    for (icompt = 1; icompt <= 63; ++icompt)
    {
      buff[icompt - 1] = maovpar_.r8ovr;
      /* L20: */
    }
    ifois = 1;
  }

  /* ^JMB */
  /* Exception */
  if (*nbentr < 63)
  {
    nrest = *nbentr << 3;
    AdvApp2Var_SysBase::mcrfill_(&nrest, buff, &dtable[1]);
  }
  else
  {

    /* Start & initialization */
    ioct = 504;
    AdvApp2Var_SysBase::mcrfill_(&ioct, buff, &dtable[1]);
    indic = 63;

    /* Loop. The upper limit is the integer value of the logarithm of base 2
     */
    /* of NBENTR/NLONGR. */
    i__1 = (integer)(std::log((real)(*nbentr) / (float)63.) / std::log((float)2.));
    for (ibid = 1; ibid <= i__1; ++ibid)
    {

      AdvApp2Var_SysBase::mcrfill_(&ioct, &dtable[1], &dtable[indic + 1]);
      ioct += ioct;
      indic += indic;

      /* L10: */
    }

    nrest = (*nbentr - indic) << 3;

    if (nrest > 0)
    {
      AdvApp2Var_SysBase::mcrfill_(&nrest, &dtable[1], &dtable[indic + 1]);
    }
  }
  return 0;
} /* maoverf_ */

//=================================================================================================

int AdvApp2Var_SysBase::maovsr8_(integer* ivalcs)
{
  *ivalcs = maovpar_.r8ncs;
  return 0;
} /* maovsr8_ */

//=================================================================================================

int matrlog_(const char*, // cnmlog,
             const char*, // chaine,
             integer* length,
             integer* iercod,
             ftnlen, // cnmlog_len,
             ftnlen) // chaine_len)

{
  *iercod = 1;
  *length = 0;

  return 0;
} /* matrlog_ */

//=================================================================================================

int matrsym_(const char* cnmsym,
             const char*, // chaine,
             integer* length,
             integer* iercod,
             ftnlen   cnmsym_len,
             ftnlen) // chaine_len)

{
  /* Local variables */
  char chainx[255] = {};

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       RETURN THE VALUE OF A SYMBOL DEFINED DURING THE */
  /*       INITIALISATION OF A USER */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       TRANSLATION, SYMBOL */

  /*     INPUT ARGUMENTS : */
  /*     -------------------- */
  /*       CNMSYM : NAME OF THE SYMBOL */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------ */
  /*       CHAINE : TRANSLATION OF THE SYMBOL */
  /*       LENGTH : USEFUL LENGTH OF THE CHAIN */
  /*       IERCOD : ERROR CODE */
  /*              = 0 : OK */
  /*              = 1 : INEXISTING SYMBOL */
  /*              = 2 : OTHER ERROR */

  /*     COMMONS USED : */
  /*     ------------------ */
  /*       NONE */

  /*     REFERENCES CALLED : */
  /*     --------------------- */
  /*       LIB$GET_SYMBOL,MACHDIM */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*       - THIS ROUTINE IS VAX SPECIFIC */
  /*       - IN CASE OF ERROR (IERCOD>0), CHAIN = ' ' AND LENGTH = 0 */
  /*       - IF THE INPUT VARIABLE CNMSYM IS EMPTY, THE ROUTINE RETURNS IERCOD=1*/
  /* > */
  /* ***********************************************************************
   */

  /* SGI...v */

  /* SGI  CALL MAGTLOG (CNMSYM,CHAINE,LENGTH,IERCOD) */
  magtlog_(cnmsym, chainx, length, iercod, cnmsym_len, 255L);
  /* SO...v */
  if (*iercod == 5)
  {
    *iercod = 1;
  }
  /* SO...^ */
  if (*iercod >= 2)
  {
    *iercod = 2;
  }
  // if (__s__cmp(chainx, "NONE", 255L, 4L) == 0) {
  if (__s__cmp() == 0)
  {
    //__s__copy(chainx, " ", 255L, 1L);
    *length = 0;
  }
  //__s__copy(chaine, chainx, chaine_len, 255L);
  /* SGI...^ */

  /* ***********************************************************************
   */
  /*     ERROR PROCESSING */
  /* ***********************************************************************
   */

  /* L9999: */
  return 0;
} /* matrsym_ */

//=================================================================================================

int mcrcomm_(integer* kop, integer* noct, intptr_t* iadr, integer* ier)

{
  /* Initialized data */

  integer ntab = 0;

  /* System generated locals */
  integer i__1, i__2;

  /* Local variables */
  intptr_t   ideb;
  doublereal dtab[32000];
  intptr_t   itab[160] /* was [4][40] */;
  intptr_t   ipre;
  integer    i__, j, k;

  /************************************************************************
  *******/

  /*     FUNCTION : */
  /*     ---------- */
  /*        DYNAMIC ALLOCATION ON COMMON */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        . ALLOCDYNAMIQUE, MEMORY, COMMON, ALLOC */

  /*     INPUT ARGUMENTS : */
  /*     ------------------ */
  /*        KOP    : (1,2) = (ALLOCATION,DESTRUCTION) */
  /*        NOCT   : NUMBER OF OCTETS */

  /*     OUTPUT ARGUMENTS  : */
  /*     ------------------- */
  /*        IADR   : ADDRESS IN MEMORY OF THE FIRST OCTET */
  /*        *      : */
  /*        *      : */
  /*        IERCOD : ERROR CODE */

  /*        IERCOD = 0 : OK */
  /*        IERCOD > 0 : CRITICAL ERROR  */
  /*        IERCOD < 0 : WARNING */
  /*        IERCOD = 1 : ERROR DESCRIPTION */
  /*        IERCOD = 2 : ERROR DESCRIPTION */

  /*     COMMONS USED   : */
  /*     ---------------- */

  /*    CRGEN2 */

  /*     REFERENCES CALLED   : */
  /*     ---------------------- */

  /*     Type  Name */
  /*           MCRLOCV */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /*   ATTENTION .... ITAB ARE NTAB NOT SAVED BETWEEN 2 CALLS..
   */

  /* > */
  /* ***********************************************************************
   */

  /* JPF  PARAMETER ( MAXNUM = 40 , MAXCOM = 500 * 1024 ) */

  /*  ITAB : TABLE OF MANAGEMENT OF DTAB, ALLOCATED MEMORY ZONE . */
  /*  NTAB : NUMBER OF COMPLETED ALLOCATIONS. */
  /*     FORMAT OF ITAB : NUMBER OF ALLOCATED REAL*8, ADDRESS OF THE 1ST REAL*8
   */
  /*                      , NOCT , VIRTUAL ADDRESS */

  /* PP      COMMON / CRGEN2 / DTAB */

  /* ----------------------------------------------------------------------*
   */

  *ier = 0;

  /*  ALLOCATION : FIND A HOLE */

  if (*kop == 1)
  {
    *iadr = 0;
    if (*noct < 1)
    {
      *ier = 1;
      goto L9900;
    }
    if (ntab >= 40)
    {
      *ier = 2;
      goto L9900;
    }

    i__1 = ntab + 1;
    for (i__ = 1; i__ <= i__1; ++i__)
    {
      if (i__ <= 1)
      {
        ipre = 1;
      }
      else
      {
        ipre = itab[((i__ - 1) << 2) - 3] + itab[((i__ - 1) << 2) - 4];
      }
      if (i__ <= ntab)
      {
        ideb = itab[(i__ << 2) - 3];
      }
      else
      {
        ideb = 32001;
      }
      if ((ideb - ipre) << 3 >= *noct)
      {
        /*  A HOLE WAS FOUND */
        i__2 = i__;
        for (j = ntab; j >= i__2; --j)
        {
          for (k = 1; k <= 4; ++k)
          {
            itab[k + ((j + 1) << 2) - 5] = itab[k + (j << 2) - 5];
            /* L1003: */
          }
          /* L1002: */
        }
        ++ntab;
        itab[(i__ << 2) - 4] = *noct / 8 + 1;
        itab[(i__ << 2) - 3] = ipre;
        itab[(i__ << 2) - 2] = *noct;
        *iadr                = reinterpret_cast<intptr_t>(&dtab[ipre - 1]);
        itab[(i__ << 2) - 1] = *iadr;
        goto L9900;
      }
      /* L1001: */
    }

    /*  NO HOLE */

    *ier = 3;
    goto L9900;

    /* ----------------------------------- */
    /*  DESTRUCTION OF THE ALLOCATION NUM : */
  }
  else
  {
    i__1 = ntab;
    for (i__ = 1; i__ <= i__1; ++i__)
    {
      if (*noct != itab[(i__ << 2) - 2])
      {
        goto L2001;
      }
      if (*iadr != itab[(i__ << 2) - 1])
      {
        goto L2001;
      }
      /*  THE ALLOCATION TO BE REMOVED WAS FOUND */
      i__2 = ntab;
      for (j = i__ + 1; j <= i__2; ++j)
      {
        for (k = 1; k <= 4; ++k)
        {
          itab[k + ((j - 1) << 2) - 5] = itab[k + (j << 2) - 5];
          /* L2003: */
        }
        /* L2002: */
      }
      --ntab;
      goto L9900;
    L2001:;
    }

    /*        THE ALLOCATION DOES NOT EXIST */

    *ier = 4;
    /* PP         GOTO 9900 */
  }

L9900:
  return 0;
} /* mcrcomm_ */

//=================================================================================================

int AdvApp2Var_SysBase::mcrdelt_(integer*  iunit,
                                 integer*  isize,
                                 void*     t,
                                 intptr_t* iofset,
                                 integer*  iercod)

{
  integer    ibid;
  doublereal xbid;
  integer    noct, iver, ksys, i__, n, nrang, ibyte, ier;
  intptr_t   iadfd, iadff, iaddr, loc; /* Les adrresses en long*/
  integer    kop;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*        DESTRUCTION OF A DYNAMIC ALLOCATION */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        SYSTEM, ALLOCATION, MEMORY, DESTRUCTION */

  /*     INPUT ARGUMENTS : */
  /*     ------------------ */
  /*        IUNIT  : NUMBER OF OCTETS OF THE ALLOCATION UNIT */
  /*        ISIZE  : NUMBER OF UNITS REQUIRED */
  /*        T      : REFERENCE ADDRESS */
  /*        IOFSET : OFFSET */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------- */
  /*        IERCOD : ERROR CODE */
  /*               = 0 : OK */
  /*               = 1 : PB OF DE-ALLOCATION OF A ZONE ALLOCATED IN COMMON */
  /*               = 2 : THE SYSTEM REFUSES TO DEMAND DE-ALLOCATION */
  /*               = 3 : THE ALLOCATION TO BE DESTROYED DOES NOT EXIST. */

  /*     COMMONS USED   : */
  /*     ---------------- */

  /*     REFERENCES CALLED   : */
  /*     --------------------- */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /*     1) UTILISATEUR */
  /*        ----------- */

  /*       MCRDELT FREES ALLOCATED MEMORY ZONE */
  /*       BY ROUTINE MCRRQST (OR CRINCR) */

  /*       THE MEANING OF ARGUMENTS IS THE SAME AS MCRRQST */

  /* *** ATTENTION : */
  /*     ----------- */
  /*     IERCOD=2 : CASE WHEN THE SYSTEM CANNOT FREE THE ALLOCATED MEMORY, */
  /*     THE FOLLOWING MESSAGE APPEARS SYSTEMATICALLY ON CONSOLE ALPHA : */
  /*     "THe system refuseS destruction of memory allocation" */

  /*     IERCOD=3 CORRESPONDS TO THE CASE WHEN THE ARGUMENTS ARE NOT CORRECT */
  /*     (THEY DO NOT ALLOW TO RECOGNIZE THE ALLOCATION IN THE TABLE)
   */

  /*     When the allocation is destroyed, the corresponding IOFSET is set to */
  /*     2 147 483 647. So, if one gets access to the table via IOFSET, there is  */
  /*     a trap. This allows to check that the freed memory zone is not usede. This verification is
   */
  /*     valid only if the same sub-program uses and destroys the allocation. */

  /* > */
  /* ***********************************************************************
   */

  /* COMMON OF PARAMETERS */

  /* COMMON OF STATISTICS */
  /*     INCLUDE MCRGENE */

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       TABLE OF MANAGEMENT OF DYNAMIC ALLOCATIONS IN MEMORY */

  /*     KEYWORDS : */
  /*     ---------- */
  /*       SYSTEM, MEMORY, ALLOCATION */

  /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */
  /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
  /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
  /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
  /*         2 : UNIT OF ALLOCATION */
  /*         3 : NB OF ALLOCATED UNITS */
  /*         4 : REFERENCE ADDRESS OF THE TABLE */
  /*         5 : IOFSET */
  /*         6 : STATIC ALLOCATION NUMBER */
  /*         7 : Required allocation size */
  /*         8 : address of the beginning of allocation */
  /*         9 : Size of the USER ZONE */
  /*        10 : ADDRESS of the START FLAG */
  /*        11 : ADDRESS of the END FLAG */
  /*        12 : Rank of creation of the allocation */

  /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
  /*   NCORE : NB OF CURRENT ALLOCS */
  /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
  /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */

  /* ----------------------------------------------------------------------*
   */

  /*     20-10-86 : BF ; INITIAL VERSION  */

  /*     NRQST : NUMBER OF ALLOCATIONS  */
  /*     NDELT : NUMBER OF LIBERATIONS */
  /*     NBYTE : TOTAL NUMBER OF OCTETS OF ALLOCATIONS */
  /*     MBYTE : MAX NUMBER OF OCTETS */

  /* Function Body */
  *iercod = 0;

  /* SEARCH IN MCRGENE */

  n   = -1;
  loc = reinterpret_cast<intptr_t>(t);

  for (i__ = mcrgene_.ncore - 1; i__ >= 0; --i__)
  {
    if (*iunit == mcrgene_.icore[i__].unit && *isize == mcrgene_.icore[i__].reqsize
        && loc == mcrgene_.icore[i__].loc && *iofset == mcrgene_.icore[i__].offset)
    {
      n = i__;
      goto L1100;
    }
    /* L1001: */
  }
L1100:

  /* IF THE ALLOCATION DOES NOT EXIST, LEAVE */

  if (n < 0)
  {
    goto L9003;
  }

  /* ALLOCATION RECOGNIZED : RETURN OTHER INFOS */

  ksys  = mcrgene_.icore[n].alloctype;
  ibyte = mcrgene_.icore[n].size;
  iaddr = mcrgene_.icore[n].addr;
  iadfd = mcrgene_.icore[n].startaddr;
  iadff = mcrgene_.icore[n].endaddr;
  nrang = mcrgene_.icore[n].rank;

  /*     Control of flags */

  madbtbk_(&iver);
  if (iver == 1)
  {
    macrchk_();
  }

  if (ksys == static_allocation)
  {
    /* DE-ALLOCATION ON COMMON */
    kop = 2;
    mcrcomm_(&kop, &ibyte, &iaddr, &ier);
    if (ier != 0)
    {
      goto L9001;
    }
  }
  else
  {
    /* DE-ALLOCATION SYSTEM */
    mcrfree_(&ibyte, iaddr, &ier);
    if (ier != 0)
    {
      goto L9002;
    }
  }

  /* CALL ALLOWING TO CANCEL AUTOMATIC WATCH BY THE DEBUGGER */

  macrclw_(&iadfd, &iadff, &nrang);

  /* UPDATE OF STATISTICS */
  ++mcrstac_.ndelt[ksys];
  mcrstac_.nbyte[ksys] -= mcrgene_.icore[n].unit * mcrgene_.icore[n].reqsize;

  /* REMOVAL OF PARAMETERS IN MCRGENE */
  if (n < MAX_ALLOC_NB - 1)
  {
    noct = (mcrgene_.ncore - (n + 1)) * sizeof(mcrgene_.icore[0]);
    AdvApp2Var_SysBase::mcrfill_(&noct, &mcrgene_.icore[n + 1], &mcrgene_.icore[n]);
  }
  --mcrgene_.ncore;

  /* *** Set to overflow of IOFSET */
  {
    /* nested scope needed to avoid gcc compilation error crossing
       initialization with goto*/
    /* assign max positive integer to *iofset */
    const size_t shift = sizeof(*iofset) * 8 - 1;
    *iofset            = (uintptr_t(1) << shift) - 1 /*2147483647 for 32bit*/;
  }
  goto L9900;

  /* ----------------------------------------------------------------------*
   */
  /*     ERROR PROCESSING */

L9001:
  /*  REFUSE DE-ALLOCATION BY ROUTINE 'MCRCOMM' (ALLOC DS COMMON) */
  *iercod = 1;
  AdvApp2Var_SysBase::maermsg_("MCRDELT", iercod, 7L);
  maostrd_();
  goto L9900;

/*  REFUSE DE-ALLOCATION BY THE SYSTEM */
L9002:
  *iercod = 2;
  AdvApp2Var_SysBase::maermsg_("MCRDELT", iercod, 7L);
  macrmsg_("MCRDELT", iercod, &ibid, &xbid, " ", 7L, 1L);
  maostrd_();
  goto L9900;

/* ALLOCATION DOES NOT EXIST */
L9003:
  *iercod = 3;
  AdvApp2Var_SysBase::maermsg_("MCRDELT", iercod, 7L);
  maostrd_();
  goto L9900;

L9900:

  return 0;

} /* mcrdelt_ */

/*
C*********************************************************************
C
C     FUNCTION :
C     ----------
C        Transfer a memory zone in another by managing intersections
C
C     KEYWORDS :
C     -----------
C        MANIPULATION, MEMORY, TRANSFER, CHARACTER
C
C     INPUT ARGUMENTS :
C     -----------------
C        nb_car    : integer*4  number of characters to transfer.
C        source    : source memory zone.
C
C     OUTPUT ARGUMENTS  :
C     -------------------
C        dest      : zone memory destination.
C
C     COMMONS USED :
C     ----------------
C
C     REFERENCES CALLED :
C     -------------------
C
C     DEMSCRIPTION/NOTES/LIMITATIONS :
C     -----------------------------------
C        Routine portable UNIX (SGI, ULTRIX, BULL)
C

C>
C**********************************************************************
*/

//=================================================================================================

int AdvApp2Var_SysBase::mcrfill_(integer* size, void* tin, void* tout)

{
  char* jmin  = static_cast<char*>(tin);
  char* jmout = static_cast<char*>(tout);
  if (mcrfill_ABS(jmout - jmin) >= *size)
    memcpy(tout, tin, *size);
  else if (tin > tout)
  {
    integer n = *size;
    while (n-- > 0)
      *jmout++ = *jmin++;
  }
  else
  {
    integer n = *size;
    jmin += n;
    jmout += n;
    while (n-- > 0)
      *--jmout = *--jmin;
  }
  return 0;
}

/*........................................................................*/
/*                                                                        */
/*   FUNCTION :                                                           */
/*   ----------                                                           */
/*               Routines for management of the dynamic memory.               */
/*                                                                        */
/*             Routine mcrfree                                            */
/*             --------------                                             */
/*                                                                        */
/*             Desallocation of a memory zone  .                          */
/*                                                                        */
/*             CALL MCRFREE (IBYTE,IADR,IER)                              */
/*                                                                        */
/*             IBYTE INTEGER*4 : Nb of Octets to free                     */
/*                                                                        */
/*             IADR POINTEUR   : Start Address                            */
/*                                                                        */
/*             IER  INTEGER*4  : Return Code                              */
/*                                                                        */
/*                                                                        */
/*........................................................................*/
/*                                                                        */

//=================================================================================================

int mcrfree_(integer*, // ibyte,
             intptr_t iadr,
             integer* ier)

{
  *ier = 0;
  Standard::Free((void*)iadr);
  return 0;
}

/*........................................................................*/
/*                                                                        */
/*   FONCTION :                                                           */
/*   ----------                                                           */
/*               Routines for management of the dynamic memory.           */
/*                                                                        */
/*             Routine mcrgetv                                            */
/*             --------------                                             */
/*                                                                        */
/*               Demand of memory allocation.                             */
/*                                                                        */
/*               CALL MCRGETV(IBYTE,IADR,IER)                             */
/*                                                                        */
/*               IBYTE (INTEGER*4) Nb of Bytes of allocation required     */
/*                                                                        */
/*               IADR   (INTEGER*4) : Result.                             */
/*                                                                        */
/*               IER (INTEGER*4)    : Error Code    :                     */
/*                                                                        */
/*                   = 0  ==> OK                                          */
/*                   = 1  ==> Allocation impossible                       */
/*                   = -1 ==> Offset > 2**31 - 1                          */
/*                                                                        */

/*                                                                        */
/*........................................................................*/

//=================================================================================================

int mcrgetv_(integer* sz, intptr_t* iad, integer* ier)

{

  *ier = 0;
  *iad = (intptr_t)Standard::Allocate(*sz);
  if (!*iad)
    *ier = 1;
  return 0;
}

//=================================================================================================

int AdvApp2Var_SysBase::mcrlist_(integer* ier) const

{
  /* System generated locals */
  integer i__1;

  /* Builtin functions */

  /* Local variables */
  char       cfmt[1]{};
  doublereal dfmt;
  integer    ifmt, i__, nufmt, ntotal;
  char       subrou[7];

  /************************************************************************
  *******/

  /*     FUNCTION : */
  /*     ---------- */
  /*   PRINT TABLE OF CURRENT DYNAMIC ALLOCATIONS */

  /*     KEYWORDS : */
  /*     ----------- */
  /*   SYSTEM, ALLOCATION, MEMORY, LIST */

  /*     INPUT ARGUMENTS : */
  /*     ------------------ */
  /*        . NONE */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------- */
  /*        *      : */
  /*        *      : */
  /*        IERCOD : ERROR CODE */

  /*        IERCOD = 0 : OK */
  /*        IERCOD > 0 : SERIOUS ERROR  */
  /*        IERCOD < 0 : WARNING */
  /*        IERCOD = 1 : ERROR DESCRIPTION */
  /*        IERCOD = 2 : ERROR DESCRIPTION */

  /*     COMMONS USED   : */
  /*     ---------------- */

  /*    MCRGENE     VFORMT */

  /*     REFERENCES CALLED   : */
  /*     ---------------------- */

  /*     Type  Name */
  /*           VFORMA */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */
  /*         . NONE */

  /* > */
  /* ***********************************************************************
   */

  /*     INCLUDE MCRGENE */
  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*        TABLE FOR MANAGEMENT OF DYNAMIC MEMORY ALLOCATIONS */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        SYSTEM, MEMORY, ALLOCATION */

  /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
  /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
  /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
  /*         2 : UNIT OF ALLOCATION */
  /*         3 : NB OF ALLOCATED UNITS */
  /*         4 : REFERENCE ADDRESS OF THE TABLE */
  /*         5 : IOFSET */
  /*         6 : STATIC ALLOCATION NUMBER */
  /*         7 : Required allocation size */
  /*         8 : address of the beginning of allocation */
  /*         9 : Size of the USER ZONE */
  /*        10 : ADDRESS of the START FLAG */
  /*        11 : ADDRESS of the END FLAG */
  /*        12 : Rank of creation of the allocation */

  /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
  /*   NCORE : NB OF CURRENT ALLOCS */
  /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
  /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */

  /* ----------------------------------------------------------------------*
   */

  /* ----------------------------------------------------------------------*
   */

  *ier = 0;
  //__s__copy(subrou, "MCRLIST", 7L, 7L);

  /*     WRITE HEADING */

  nufmt = 1;
  ifmt  = mcrgene_.ncore;
  macrmsg_(subrou, &nufmt, &ifmt, &dfmt, cfmt, 7L, 1L);

  ntotal = 0;

  i__1 = mcrgene_.ncore;
  for (i__ = 0; i__ < i__1; ++i__)
  {
    nufmt = 2;
    ifmt  = mcrgene_.icore[i__].unit * mcrgene_.icore[i__].reqsize;
    macrmsg_(subrou, &nufmt, &ifmt, &dfmt, cfmt, 7L, 1L);
    ntotal += ifmt;
    /* L1001: */
  }

  nufmt = 3;
  ifmt  = ntotal;
  macrmsg_(subrou, &nufmt, &ifmt, &dfmt, cfmt, 7L, 1L);

  return 0;
} /* mcrlist_ */

//=================================================================================================

int AdvApp2Var_SysBase::mcrrqst_(integer*  iunit,
                                 integer*  isize,
                                 void*     t,
                                 intptr_t* iofset,
                                 integer*  iercod)

{

  integer i__1, i__2;

  /* Local variables */
  doublereal dfmt;
  integer    ifmt, iver;
  char       subr[7];
  integer    ksys, ibyte, irest, ier;
  intptr_t   iadfd, iadff, iaddr, lofset, loc;
  integer    izu;

  /* **********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*       IMPLEMENTATION OF DYNAMIC MEMORY ALLOCATION */

  /*     KEYWORDS : */
  /*     ----------- */
  /*       SYSTEM, ALLOCATION, MEMORY, REALISATION */

  /*     INPUT ARGUMENTS : */
  /*     ------------------ */
  /*        IUNIT  : NUMBER OF OCTET OF THE UNIT OF ALLOCATION */
  /*        ISIZE  : NUMBER OF UNITS REQUIRED */
  /*        T      : REFERENCE ADDRESS */

  /*     OUTPUT ARGUMENTS  : */
  /*     ------------------- */
  /*        IOFSET : OFFSET */
  /*        IERCOD : ERROR CODE, */
  /*               = 0 : OK */
  /*               = 1 : MAX NB OF ALLOCS REACHED */
  /*               = 2 : ARGUMENTS INCORRECT */
  /*               = 3 : REFUSED DYNAMIC ALLOCATION */

  /*     COMMONS USED   : */
  /*     ---------------- */
  /*       MCRGENE, MCRSTAC */

  /*     REFERENCES CALLED   : */
  /*     ----------------------- */
  /*       MACRCHK, MACRGFL, MACRMSG, MCRLOCV,MCRCOMM, MCRGETV */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /*     1) USER */
  /*     -------------- */

  /* T IS THE ADDRESS OF A TABLE, IOFSET REPRESENTS THE DEPLACEMENT IN */
  /* UNITS OF IUNIT OCTETS BETWEEN THE ALLOCATED ZONE AND TABLE T */
  /* IERCOD=0 SIGNALS THAT THE ALLOCATION WORKS WELL, ANY OTHER */
  /* VALUE INDICATES A BUG. */

  /*     EXAMPLE : */
  /*          LET THE DECLARATION REAL*4 T(1), SO IUNIT=4 . */
  /*          CALL TO MCRRQST PORODUCES DYNAMIC ALLOCATION */
  /*          AND GIVES VALUE TO VARIABLE IOFSET, */
  /*          IF IT IS REQUIRED TO WRITE 1. IN THE 5TH ZONE REAL*4 */
  /*          ALLOCATED IN THIS WAY, MAKE: */
  /*          T(5+IOFSET)=1. */

  /*     CASE OF ERRORS : */
  /*     --------------- */

  /*     IERCOD=1 : MAX NB OF ALLOCATION REACHED (ACTUALLY 200) */
  /*     AND THE FOLLOWING MESSAGE APPEARS IN THE CONSOLE ALPHA : */
  /*     "The max number of memory allocation is reached : ,N" */

  /*     IERCOD=2 : ARGUMENT IUNIT INCORRECT AS IT IS DIFFERENT FROM 1,2,4 OR 8 */
  /*     AND THE FOLLOWING MESSAGE APPEARS IN THE CONSOLE ALPHA : */
  /*     "Unit OF allocation invalid : ,IUNIT" */

  /*     IERCOD=3 : REFUSED DYNAMIC ALLOCATION (MORE PLACE IN MEMORY) */
  /*     AND THE FOLLOWING MESSAGE APPEARS IN THE CONSOLE ALPHA : */
  /*    "The system refuses dynamic allocation of memory of N octets"
   */
  /*     with completev display of all allocations carried out till now */

  /*     2) DESIGNER */
  /*     -------------- */

  /* MCRRQST MAKES DYNAMIC ALLOCATION OF VIRTUAL MEMORY ON THE BASE */
  /* OF ENTITIES OF 8 OCTETS (QUADWORDS), WHILE THE ALLOCATION IS REQUIRED BY */
  /* UNITS OF IUNIT OCTETS (1,2,4,8). */

  /* THE REQUIRED QUANTITY IS IUNIT*ISIZE OCTETS, THIS VALUE IS ROUNDED */
  /* SO THAT THE ALLOCATION WAS AN INTEGER NUMBER OF QUADWORDS. */

  /* > */
  /* ***********************************************************************
   */

  /* COMMON OF PARAMETRES */
  /* COMMON OF INFORMATION ON STATISTICS */
  /*     INCLUDE MCRGENE */

  /* ***********************************************************************
   */
  /*     FUNCTION : */
  /*     ---------- */
  /*        TABLE FOR MANAGEMENT OF DYNAMIC MEMORY ALLOCATIONS */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        SYSTEM, MEMORY, ALLOCATION */

  /*     DEMSCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /*   ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
  /*         1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
  /*             (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
  /*         2 : UNIT OF ALLOCATION */
  /*         3 : NB OF ALLOCATED UNITS */
  /*         4 : REFERENCE ADDRESS OF THE TABLE */
  /*         5 : IOFSET */
  /*         6 : STATIC ALLOCATION NUMBER */
  /*         7 : Required allocation size */
  /*         8 : address of the beginning of allocation */
  /*         9 : Size of the USER ZONE */
  /*        10 : ADDRESS of the START FLAG */
  /*        11 : ADDRESS of the END FLAG */
  /*        12 : Rank of creation of the allocation */

  /*   NDIMCR : NB OF DATA OF EACH ALLOC IN ICORE */
  /*   NCORE : NB OF CURRENT ALLOCS */
  /*   LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
  /*   FLAG  : VALUE OF THE FLAG USED FOR EXCESSES */

  /* ----------------------------------------------------------------------*
   */
  /*     20-10-86 : BF ; INITIAL VERSION  */

  /*     NRQST : NUMBER OF ALLOCATIONS  */
  /*     NDELT : NUMBER OF LIBERATIONS */
  /*     NBYTE : TOTAL NUMBER OF OCTETS OF ALLOCATIONS */
  /*     MBYTE : MAX NUMBER OF OCTETS */

  /* ----------------------------------------------------------------------*
   */

  /* Function Body */
  *iercod = 0;

  if (mcrgene_.ncore >= MAX_ALLOC_NB)
  {
    goto L9001;
  }
  if (*iunit != 1 && *iunit != 2 && *iunit != 4 && *iunit != 8)
  {
    goto L9002;
  }

  /* Calculate the size required by the user */
  ibyte = *iunit * *isize;

  /* Find the type of version (Phase of Production or Version Client) */
  madbtbk_(&iver);

  /* Control allocated size in Production phase */

  if (iver == 1)
  {

    if (ibyte == 0)
    {
      // do__lio(&c__9, &c__1, "Require zero allocation", 26L);
      maostrb_();
    }
    else if (ibyte >= 4096000)
    {
      // do__lio(&c__9, &c__1, "Require allocation above 4 Mega-Octets : ", 50L);
      // do__lio(&c__3, &c__1, (char *)&ibyte, (ftnlen)sizeof(integer));
      maostrb_();
    }
  }

  /* CALCULATE THE SIZE OF THE USER ZONE (IZU) */
  /*     . add size required by the user (IBYTE) */
  /*     . add delta for alinement with the base */
  /*     . round to multiple of 8 above */

  loc   = reinterpret_cast<intptr_t>(t);
  izu   = ibyte + loc % *iunit;
  irest = izu % 8;
  if (irest != 0)
  {
    izu = izu + 8 - irest;
  }

  /* CALCULATE THE SIZE REQUIRED FROM THE PRIMITIVE OF ALLOC */
  /*     . add size of the user zone */
  /*     . add 8 for alinement of start address of */
  /*       allocation on multiple of 8 so that to be able to  */
  /*       set flags with Double Precision without other pb than alignment */
  /*     . add 16 octets for two flags */

  ibyte = izu + 24;

  /* DEMAND OF ALLOCATION */

  /* L1001: */
  /*      IF ( ISYST.EQ.0.AND.IBYTE .LE. 100 * 1024 ) THEN */
  /*        ALLOCATION SUR TABLE */
  /*         KSYS = 1 */
  /*         KOP = 1 */
  /*         CALL MCRCOMM ( KOP , IBYTE , IADDR , IER ) */
  /*         IF ( IER .NE. 0 ) THEN */
  /*            ISYST=1 */
  /*            GOTO 1001 */
  /*         ENDIF */
  /*      ELSE */
  /*        ALLOCATION SYSTEME */
  ksys = heap_allocation;
  mcrgetv_(&ibyte, &iaddr, &ier);
  if (ier != 0)
  {
    goto L9003;
  }
  /*      ENDIF */

  /* CALCULATE THE ADDRESSES OF FLAGS */

  iadfd = iaddr + 8 - iaddr % 8;
  iadff = iadfd + 8 + izu;

  /* CALCULATE USER OFFSET : */
  /*     . difference between the user start address and the */
  /*       base address */
  /*     . converts this difference in the user unit */

  lofset  = iadfd + 8 + loc % *iunit - loc;
  *iofset = lofset / *iunit;

  /* If phase of production control flags */
  if (iver == 1)
  {
    macrchk_();
  }

  /*     SET FLAGS */
  /*     . the first flag is set by IADFD and the second by IADFF */
  /*     . if phase of production, set to overflow the ZU */
  macrgfl_(&iadfd, &iadff, &iver, &izu);

  /* RANGING OF PARAMETERS IN MCRGENE */

  mcrgene_.icore[mcrgene_.ncore].prot      = mcrgene_.lprot;
  mcrgene_.icore[mcrgene_.ncore].unit      = (unsigned char)(*iunit);
  mcrgene_.icore[mcrgene_.ncore].reqsize   = *isize;
  mcrgene_.icore[mcrgene_.ncore].loc       = loc;
  mcrgene_.icore[mcrgene_.ncore].offset    = *iofset;
  mcrgene_.icore[mcrgene_.ncore].alloctype = (unsigned char)ksys;
  mcrgene_.icore[mcrgene_.ncore].size      = ibyte;
  mcrgene_.icore[mcrgene_.ncore].addr      = iaddr;
  mcrgene_.icore[mcrgene_.ncore].userzone  = mcrgene_.ncore;
  mcrgene_.icore[mcrgene_.ncore].startaddr = iadfd;
  mcrgene_.icore[mcrgene_.ncore].endaddr   = iadff;
  mcrgene_.icore[mcrgene_.ncore].rank      = mcrgene_.ncore + 1;
  ++mcrgene_.ncore;

  mcrgene_.lprot = 0;

  /* CALL ALLOWING AUTOIMPLEMENTATION OF THE SET WATCH BY THE DEBUGGER */

  macrstw_(&iadfd, &iadff, &mcrgene_.ncore);

  /* STATISTICS */

  ++mcrstac_.nrqst[ksys];
  mcrstac_.nbyte[ksys] +=
    mcrgene_.icore[mcrgene_.ncore - 1].unit * mcrgene_.icore[mcrgene_.ncore - 1].reqsize;
  /* Computing MAX */
  i__1 = mcrstac_.mbyte[ksys], i__2 = mcrstac_.nbyte[ksys];
  mcrstac_.mbyte[ksys] = advapp_max(i__1, i__2);

  goto L9900;

/* ----------------------------------------------------------------------*
 */
/*  ERROR PROCESSING */

/*  MAX NB OF ALLOC REACHED : */
L9001:
  *iercod = 1;
  ifmt    = MAX_ALLOC_NB;
  //__s__copy(subr, "MCRRQST", 7L, 7L);
  macrmsg_(subr, iercod, &ifmt, &dfmt, " ", 7L, 1L);
  maostrd_();
  goto L9900;

/*  INCORRECT ARGUMENTS */
L9002:
  *iercod = 2;
  ifmt    = *iunit;
  //__s__copy(subr, "MCRRQST", 7L, 7L);
  macrmsg_(subr, iercod, &ifmt, &dfmt, " ", 7L, 1L);
  goto L9900;

/* SYSTEM REFUSES ALLOCATION */
L9003:
  *iercod = 3;
  ifmt    = ibyte;
  //__s__copy(subr, "MCRRQST", 7L, 7L);
  macrmsg_(subr, iercod, &ifmt, &dfmt, " ", 7L, 1L);
  maostrd_();
  mcrlist_(&ier);
  goto L9900;

  /* ----------------------------------------------------------------------*
   */

L9900:
  mcrgene_.lprot = 0;
  return 0;
} /* mcrrqst_ */

//=================================================================================================

int AdvApp2Var_SysBase::mgenmsg_(const char*, // nomprg,
                                 ftnlen)      // nomprg_len)

{
  return 0;
} /* mgenmsg_ */

//=================================================================================================

int AdvApp2Var_SysBase::mgsomsg_(const char*, // nomprg,
                                 ftnlen)      // nomprg_len)

{
  return 0;
} /* mgsomsg_ */

/*
C
C*****************************************************************************
C
C     FUNCTION : CALL MIRAZ(LENGTH,ITAB)
C     ----------
C
C     RESET TO ZERO A TABLE OF LOGIC OR INTEGER.
C
C     KEYWORDS :
C     -----------
C        RAZ INTEGER
C
C     INPUT ARGUMENTS  :
C     ------------------
C               LENGTH : NUMBER OF OCTETS TO TRANSFER
C               ITAB   : NAME OF THE TABLE
C
C     OUTPUT ARGUMENTS  :
C     -------------------
C               ITAB   : NAME OF THE TABLE SET TO ZERO
C
C     COMMONS USED   :
C     ----------------
C
C     REFERENCES CALLED   :
C     ---------------------
C
C     DEMSCRIPTION/NOTES/LIMITATIONS :
C     -----------------------------------
C
C           Portable VAX-SGI

C>
C***********************************************************************
*/
//=================================================================================================

void AdvApp2Var_SysBase::miraz_(integer* taille, void* adt)

{
  memset(adt, '\0', *taille);
}

//=================================================================================================

integer AdvApp2Var_SysBase::mnfndeb_()
{
  integer ret_val;
  ret_val = 0;
  return ret_val;
} /* mnfndeb_ */

//=================================================================================================

int AdvApp2Var_SysBase::msifill_(integer* nbintg, integer* ivecin, integer* ivecou)
{
  integer nocte;

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*      transfer Integer from one  zone to another */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        TRANSFER , INTEGER , MEMORY */

  /*     INPUT ARGUMENTS : */
  /*     ------------------ */
  /*        NBINTG : Nb of integers */
  /*        IVECIN : Input vector */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------- */
  /*        IVECOU : Output vector */

  /*     COMMONS USED   : */
  /*     ---------------- */

  /*     REFERENCES CALLED   : */
  /*     --------------------- */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /* ___ NOCTE : Number of octets to transfer */

  /* Parameter adjustments */
  --ivecou;
  --ivecin;

  /* Function Body */
  nocte = *nbintg * sizeof(integer);
  AdvApp2Var_SysBase::mcrfill_(&nocte, &ivecin[1], &ivecou[1]);
  return 0;
} /* msifill_ */

//=================================================================================================

int AdvApp2Var_SysBase::msrfill_(integer* nbreel, doublereal* vecent, doublereal* vecsor)
{
  integer nocte;

  /* ***********************************************************************
   */

  /*     FONCTION : */
  /*     ---------- */
  /*        Transfer real from one zone to another */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        TRANSFER , REAL , MEMORY */

  /*     INPUT ARGUMENTS : */
  /*     ----------------- */
  /*        NBREEL : Number of reals */
  /*        VECENT : Input vector */

  /*     OUTPUT ARGUMENTS : */
  /*     ------------------- */
  /*        VECSOR : Output vector */

  /*     COMMONS USED   : */
  /*     ---------------- */

  /*     REFERENCES CALLED   : */
  /*     ----------------------- */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */

  /* ___ NOCTE : Nb of octets to transfer */

  /* Parameter adjustments */
  --vecsor;
  --vecent;

  /* Function Body */
  nocte = *nbreel * sizeof(doublereal);
  AdvApp2Var_SysBase::mcrfill_(&nocte, &vecent[1], &vecsor[1]);
  return 0;
} /* msrfill_ */

//=================================================================================================

int AdvApp2Var_SysBase::mswrdbg_(const char*, // ctexte,
                                 ftnlen)      // ctexte_len)

{

  /* ***********************************************************************
   */

  /*     FUNCTION : */
  /*     ---------- */
  /*        Write message on console alpha if IBB>0 */

  /*     KEYWORDS : */
  /*     ----------- */
  /*        MESSAGE, DEBUG */

  /*     INPUT ARGUMENTS : */
  /*     ----------------- */
  /*        CTEXTE : Text to be written */

  /*     OUTPUT ARGUMENTS  : */
  /*     ------------------- */
  /*        None */

  /*     COMMONS USED   : */
  /*     ---------------- */

  /*     REFERENCES CALLED   : */
  /*     ----------------------- */

  /*     DESCRIPTION/NOTES/LIMITATIONS : */
  /*     ----------------------------------- */

  /* > */
  /* ***********************************************************************
   */
  /*                      DECLARATIONS */
  /* ***********************************************************************
   */

  /* ***********************************************************************
   */
  /*                      PROCESSING */
  /* ***********************************************************************
   */

  if (AdvApp2Var_SysBase::mnfndeb_() >= 1)
  {
    // do__lio(&c__9, &c__1, "Dbg ", 4L);
    // do__lio(&c__9, &c__1, ctexte, ctexte_len);
  }
  return 0;
} /* mswrdbg_ */

int __i__len()
{
  return 0;
}

int __s__cmp()
{
  return 0;
}

//=================================================================================================

int AdvApp2Var_SysBase::do__fio()
{
  return 0;
}

//=================================================================================================

int AdvApp2Var_SysBase::do__lio()
{
  return 0;
}

/*
C*****************************************************************************
C
C     FUNCTION : CALL MVRIRAZ(NBELT,DTAB)
C     ----------
C     Reset to zero a table with DOUBLE PRECISION
C
C     KEYWORDS :
C     -----------
C     MVRMIRAZ DOUBLE
C
C     INPUT ARGUMENTS :
C     ------------------
C     NBELT  : Number of elements of the table
C     DTAB   : Table to initializer to zero
C
C     OUTPUT ARGUMENTS :
C     --------------------
C     DTAB   : Table reset to zero
C
C     COMMONS USED  :
C     ----------------
C
C     REFERENCES CALLED   :
C     -----------------------
C
C     DEMSCRIPTION/NOTES/LIMITATIONS :
C     -----------------------------------
C
C
C>
C***********************************************************************
*/
//=================================================================================================

void AdvApp2Var_SysBase::mvriraz_(integer* taille, void* adt)

{
  integer offset;
  offset = *taille * 8;
  /*    printf(" adt %d  long %d\n",adt,offset); */
  memset(adt, '\0', offset);
}
