OpenCascade/occt
1
0
Fork 0
mirror of https://git.dev.opencascade.org/repos/occt.git synced 2025-04-10 18:51:21 +03:00
Code
occt/src/AdvApp2Var/AdvApp2Var_SysBase.cxx

3439 lines
92 KiB
C++
Executable File
Raw Blame History

//
// AdvApp2Var_SysBase.cxx
//
#include <math.h>
#include <stdlib.h>
#include <string.h>
#include <AdvApp2Var_Data_f2c.hxx>
#include <AdvApp2Var_SysBase.hxx>
//
#include <AdvApp2Var_Data.hxx>
static
int __i__len();
static
int __s__cmp();
static
int macrbrk_();
static
int macrchk_();
static
int macrclw_(long int *iadfld,
long int *iadflf,
integer *nalloc);
static
int macrerr_(long int *iad,
integer *nalloc);
static
int macrgfl_(long int *iadfld,
long int *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_(integer *iadfld,
integer *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,
long int *iadr,
integer *ier);
static
int mcrfree_(integer *ibyte,
uinteger *iadr,
integer *ier);
static
int mcrgetv_(integer *sz,
uinteger *iad,
integer *ier);
static
int mcrlist_(integer *ier);
static
int mcrlocv_(long int t,
long int *l);
/* Structures */
static struct {
long int icore[12000];
integer ncore, lprot;
} mcrgene_;
static struct {
integer nrqst[2], ndelt[2], nbyte[2], mbyte[2];
} mcrstac_;
static struct {
integer lec, imp, keyb, mae, jscrn, itblt, ibb;
} mblank__;
#define mcrfill_ABS(a) (((a)<0)?(-(a)):(a))
//=======================================================================
//function : macinit_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::macinit_(integer *imode,
integer *ival)
{
/* Fortran I/O blocks */
static cilist io______1 = { 0, 0, 0, (char*) "(' --- Debug-mode : ',I10,' ---')", 0 };
/* ************************************************************************/
/* 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;
io______1.ciunit = mblank__.imp;
/*
s__wsfe(&io______1);
*/
/*
do__fio(&c____1, (char *)&mblank__.ibb, (ftnlen)sizeof(integer));
*/
AdvApp2Var_SysBase::e__wsfe();
} else if (*imode == 3) {
mblank__.lec = *ival;
}
/* ----------------------------------------------------------------------*
*/
return 0;
} /* macinit__ */
//=======================================================================
//function : macrai4_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::macrai4_(integer *nbelem,
integer *maxelm,
integer *itablo,
long int *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;
/* Parameter adjustments */
--itablo;
iunit = sizeof(integer);
/* Function Body */
if (*nbelem > *maxelm) {
AdvApp2Var_SysBase::mcrrqst_(&iunit, nbelem, (doublereal *)&itablo[1], iofset, iercod);
} else {
*iercod = 0;
*iofset = 0;
}
return 0 ;
} /* macrai4_ */
//=======================================================================
//function : AdvApp2Var_SysBase::macrar8_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::macrar8_(integer *nbelem,
integer *maxelm,
doublereal *xtablo,
long int *iofset,
integer *iercod)
{
static 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. */
/* > */
/* ***********************************************************************
*/
/* Parameter adjustments */
--xtablo;
/* Function Body */
if (*nbelem > *maxelm) {
AdvApp2Var_SysBase::mcrrqst_(&c__8, nbelem, &xtablo[1], iofset, iercod);
} else {
*iercod = 0;
*iofset = 0;
}
return 0 ;
} /* macrar8_ */
//=======================================================================
//function : macrbrk_
//purpose :
//=======================================================================
int macrbrk_()
{
return 0 ;
} /* macrbrk_ */
//=======================================================================
//function : macrchk_
//purpose :
//=======================================================================
int macrchk_()
{
/* System generated locals */
integer i__1;
/* Local variables */
static integer i__, j;
static long int ioff;
static doublereal t[1];
static integer loc;
/* ***********************************************************************
*/
/* 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 MEMOTY 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 */
/* ----------------------------------------------------------------------*
*/
/* ----------------------------------------------------------------------*
*/
/* CALCULATE ADDRESS OF T */
mcrlocv_((long int)t, (long int *)&loc);
/* CONTROL OF FLAGS IN THE TABLE */
i__1 = mcrgene_.ncore;
for (i__ = 1; i__ <= i__1; ++i__) {
for (j = 10; j <= 11; ++j) {
if (mcrgene_.icore[j + i__ * 12 - 13] != -1) {
ioff = (mcrgene_.icore[j + i__ * 12 - 13] - loc) / 8;
if (t[ioff] != -134744073.) {
/* MSG : '*** ERREUR : REMOVAL FROM MEMORY OF ADDRESS
E:',ICORE(J,I) */
/* AND OF RANK ICORE(12,I) */
macrerr_((long int *)&mcrgene_.icore[j + i__ * 12 - 13],
(integer *)&mcrgene_.icore[i__ * 12 - 1]);
/* BACK-PARCING IN PHASE OF PRODUCTION */
maostrb_();
/* REMOVAL OF THE ADDRESS OF FLAG TO AVOID REMAKING ITS CONTROL */
mcrgene_.icore[j + i__ * 12 - 13] = -1;
}
}
/* L100: */
}
/* L1000: */
}
return 0 ;
} /* macrchk_ */
//=======================================================================
//function : macrclw_
//purpose :
//=======================================================================
int macrclw_(long int *,//iadfld,
long int *,//iadflf,
integer *)//nalloc)
{
return 0 ;
} /* macrclw_ */
//=======================================================================
//function : AdvApp2Var_SysBase::macrdi4_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::macrdi4_(integer *nbelem,
integer *,//maxelm,
integer *itablo,
long int *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;
/* Parameter adjustments */
--itablo;
iunit = sizeof(integer);
/* Function Body */
if (*iofset != 0) {
AdvApp2Var_SysBase::mcrdelt_(&iunit,
nbelem,
(doublereal *)&itablo[1],
iofset,
iercod);
} else {
*iercod = 0;
}
return 0 ;
} /* macrdi4_ */
//=======================================================================
//function : AdvApp2Var_SysBase::macrdr8_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::macrdr8_(integer *nbelem,
integer *,//maxelm,
doublereal *xtablo,
long int *iofset,
integer *iercod)
{
static 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) */
/* > */
/* ***********************************************************************
*/
/* Parameter adjustments */
--xtablo;
/* Function Body */
if (*iofset != 0) {
AdvApp2Var_SysBase::mcrdelt_(&c__8, nbelem, &xtablo[1], iofset, iercod);
} else {
*iercod = 0;
}
return 0 ;
} /* macrdr8_ */
//=======================================================================
//function : macrerr_
//purpose :
//=======================================================================
int macrerr_(long int *,//iad,
integer *)//nalloc)
{
//static integer c__1 = 1;
/* Builtin functions */
//integer /*s__wsfe(),*/ /*do__fio(),*/ e__wsfe();
/* Fortran I/O blocks */
//static 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 : */
/* ----------------------------------- */
/* > */
/* ***********************************************************************
*/
/*
s__wsfe(&io___1);
*/
/*
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));
*/
AdvApp2Var_SysBase::e__wsfe();
return 0 ;
} /* macrerr_ */
//=======================================================================
//function : macrgfl_
//purpose :
//=======================================================================
int macrgfl_(long int *iadfld,
long int *iadflf,
integer *iphase,
integer *iznuti)
{
/* Initialized data */
static integer ifois = 0;
static char cbid[1];
static integer ibid, ienr;
static doublereal t[1];
static integer novfl;
static long int ioff,iadrfl, iadt;
/* ***********************************************************************
*/
/* 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 ADDRESS OF T */
mcrlocv_((long int)t, (long int *)&iadt);
/* CALCULATE THE OFFSET */
ioff = (*iadfld - iadt) / 8;
/* SET TO OVERFLOW OF THE USER ZONE IN CASE OF PRODUCTION VERSION */
if (*iphase == 1 && novfl == 0) {
ienr = *iznuti / 8;
maoverf_(&ienr, &t[ioff + 1]);
}
/* UPDATE THE START FLAG */
t[ioff] = -134744073.;
/* FAKE CALL TO STOP THE DEBUGGER : */
iadrfl = *iadfld;
macrbrk_();
/* UPDATE THE START FLAG */
ioff = (*iadflf - iadt) / 8;
t[ioff] = -134744073.;
/* FAKE CALL TO STOP THE DEBUGGER : */
iadrfl = *iadflf;
macrbrk_();
return 0 ;
} /* macrgfl_ */
//=======================================================================
//function : macrmsg_
//purpose :
//=======================================================================
int macrmsg_(const char *,//crout,
integer *,//num,
integer *it,
doublereal *xt,
const char *ct,
ftnlen ,//crout_len,
ftnlen ct_len)
{
/* Local variables */
static integer inum, iunite;
static char cfm[80], cln[3];
/* Fortran I/O blocks */
static cilist io___5 = { 0, 0, 0, cfm, 0 };
static cilist io___6 = { 0, 0, 0, cfm, 0 };
static cilist io___7 = { 0, 0, 0, cfm, 0 };
/* ***********************************************************************
*/
/* 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;
--xt;
--it;
/* 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 : */
iunite = AdvApp2Var_SysBase::mnfnimp_();
if (inum == 0) {
io___5.ciunit = iunite;
/*
s__wsfe(&io___5);
*/
AdvApp2Var_SysBase::e__wsfe();
} else if (inum == 1) {
io___6.ciunit = iunite;
/*
s__wsfe(&io___6);
*/
/*
do__fio(&c__1, (char *)&it[1], (ftnlen)sizeof(integer));
*/
AdvApp2Var_SysBase::e__wsfe();
} else {
/* MESSAGE DOES NOT EXIST ... */
io___7.ciunit = iunite;
/*
s__wsfe(&io___7);
*/
/*
do__fio(&c__1, (char *)&(*num), (ftnlen)sizeof(integer));
do__fio(&c__1, crout, crout_len);
*/
AdvApp2Var_SysBase::e__wsfe();
}
return 0;
} /* macrmsg_ */
//=======================================================================
//function : macrstw_
//purpose :
//=======================================================================
int macrstw_(integer *,//iadfld,
integer *,//iadflf,
integer *)//nalloc)
{
return 0 ;
} /* macrstw_ */
//=======================================================================
//function : madbtbk_
//purpose :
//=======================================================================
int madbtbk_(integer *indice)
{
*indice = 0;
return 0 ;
} /* madbtbk_ */
//=======================================================================
//function : AdvApp2Var_SysBase::maermsg_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::maermsg_(const char *,//cnompg,
integer *,//icoder,
ftnlen )//cnompg_len)
{
return 0 ;
} /* maermsg_ */
//=======================================================================
//function : magtlog_
//purpose :
//=======================================================================
int magtlog_(const char *cnmlog,
const char *,//chaine,
integer *long__,
integer *iercod,
ftnlen cnmlog_len,
ftnlen )//chaine_len)
{
/* Local variables */
static char cbid[255];
static 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_ */
//=======================================================================
//function : mainial_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::mainial_()
{
mcrgene_.ncore = 0;
return 0 ;
} /* mainial_ */
//=======================================================================
//function : AdvApp2Var_SysBase::maitbr8_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::maitbr8_(integer *itaill,
doublereal *xtab,
doublereal *xval)
{
static integer c__504 = 504;
/* Initialized data */
static 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 */
static integer i__;
static doublereal buffx[63];
static 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, (char *)buff0, (char *)&xtab[(nufois - 1) * 63 + 1]);
/* L1000: */
}
}
if (nreste >= 1) {
i__1 = nreste << 3;
AdvApp2Var_SysBase::mcrfill_(&i__1, (char *)buff0, (char *)&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, (char *)buffx, (char *)&xtab[(nufois - 1) * 63 + 1]);
/* L3000: */
}
}
if (nreste >= 1) {
i__1 = nreste << 3;
AdvApp2Var_SysBase::mcrfill_(&i__1, (char *)buffx, (char *)&xtab[noffst + 1]);
}
}
/* ----------------------------------------------------------------------*
*/
return 0;
} /* maitbr8_ */
//=======================================================================
//function : mamdlng_
//purpose :
//=======================================================================
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 INFORMATIONS 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_ */
//=======================================================================
//function : maostrb_
//purpose :
//=======================================================================
int maostrb_()
{
return 0 ;
} /* maostrb_ */
//=======================================================================
//function : maostrd_
//purpose :
//=======================================================================
int maostrd_()
{
static 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_ */
//=======================================================================
//function : maoverf_
//purpose :
//=======================================================================
int maoverf_(integer *nbentr,
doublereal *dtable)
{
/* Initialized data */
static integer ifois = 0;
/* System generated locals */
integer i__1;
/* Local variables */
static integer ibid;
static doublereal buff[63];
static 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 developpement 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 transfered*/
/* DTABLE in DTABLE. */
/* __________ */
/* ! amorce ! * Otherwise, the entire buffer is transfered 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 transfered 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 */
/* DATAS */
/* 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, (char *)buff, (char *)&dtable[1]);
} else {
/* Start & initialization */
ioct = 504;
AdvApp2Var_SysBase::mcrfill_(&ioct, (char *)buff, (char *)&dtable[1]);
indic = 63;
/* Loop. The upper limit is the integer value of the logarithm of base 2
*/
/* of NBENTR/NLONGR. */
i__1 = (integer) (log((real) (*nbentr) / (float)63.) / log((float)2.))
;
for (ibid = 1; ibid <= i__1; ++ibid) {
AdvApp2Var_SysBase::mcrfill_(&ioct, (char *)&dtable[1], (char *)&dtable[indic + 1]);
ioct += ioct;
indic += indic;
/* L10: */
}
nrest = ( *nbentr - indic ) << 3;
if (nrest > 0) {
AdvApp2Var_SysBase::mcrfill_(&nrest, (char *)&dtable[1], (char *)&dtable[indic + 1]);
}
}
return 0 ;
} /* maoverf_ */
//=======================================================================
//function : AdvApp2Var_SysBase::maovsr8_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::maovsr8_(integer *ivalcs)
{
*ivalcs = maovpar_.r8ncs;
return 0 ;
} /* maovsr8_ */
//=======================================================================
//function : matrlog_
//purpose :
//=======================================================================
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_ */
//=======================================================================
//function : matrsym_
//purpose :
//=======================================================================
int matrsym_(const char *cnmsym,
const char *,//chaine,
integer *length,
integer *iercod,
ftnlen cnmsym_len,
ftnlen )//chaine_len)
{
/* Local variables */
static 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_ */
//=======================================================================
//function : mcrcomm_
//purpose :
//=======================================================================
int mcrcomm_(integer *kop,
integer *noct,
long int *iadr,
integer *ier)
{
/* Initialized data */
static integer ntab = 0;
/* System generated locals */
integer i__1, i__2;
/* Local variables */
static integer ideb;
static doublereal dtab[32000];
static long int itab[160] /* was [4][40] */;
static integer ipre, 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;
mcrlocv_((long int)&dtab[ipre - 1], (long int *)iadr);
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_ */
//=======================================================================
//function : AdvApp2Var_SysBase::mcrdelt_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::mcrdelt_(integer *iunit,
integer *isize,
doublereal *t,
long int *iofset,
integer *iercod)
{
static integer ibid;
static doublereal xbid;
static integer noct, iver, ksys, i__, n, nrang,
ibyte, ier;
static long int iadfd, iadff, iaddr, loc; /* Long adDresses*/
static 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 */
/* KEYWORS : */
/* ----------- */
/* 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 */
/* Parameter adjustments */
--t;
/* Function Body */
*iercod = 0;
/* SEARCH IN MCRGENE */
n = 0;
mcrlocv_((long int)&t[1], (long int *)&loc);
for (i__ = mcrgene_.ncore; i__ >= 1; --i__) {
if (*iunit == mcrgene_.icore[i__ * 12 - 11] && *isize ==
mcrgene_.icore[i__ * 12 - 10] && loc == mcrgene_.icore[i__ *
12 - 9] && *iofset == mcrgene_.icore[i__ * 12 - 8]) {
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 * 12 - 7];
ibyte = mcrgene_.icore[n * 12 - 6];
iaddr = mcrgene_.icore[n * 12 - 5];
iadfd = mcrgene_.icore[n * 12 - 3];
iadff = mcrgene_.icore[n * 12 - 2];
nrang = mcrgene_.icore[n * 12 - 1];
/* Control of flags */
madbtbk_(&iver);
if (iver == 1) {
macrchk_();
}
if (ksys <= 1) {
/* DE-ALLOCATION ON COMMON */
kop = 2;
mcrcomm_(&kop, &ibyte, &iaddr, &ier);
if (ier != 0) {
goto L9001;
}
} else {
/* DE-ALLOCATION SYSTEM */
mcrfree_((integer *)&ibyte, (uinteger *)&iaddr, (integer *)&ier);
if (ier != 0) {
goto L9002;
}
}
/* CALL ALLOWING TO CANCEL AUTOMATIC WATCH BY THE DEBUGGER */
macrclw_(&iadfd, &iadff, &nrang);
/* UPDATE OF STATISTICS */
if (ksys <= 1) {
i__ = 1;
} else {
i__ = 2;
}
++mcrstac_.ndelt[i__ - 1];
mcrstac_.nbyte[i__ - 1] -= mcrgene_.icore[n * 12 - 11] *
mcrgene_.icore[n * 12 - 10];
/* REMOVAL OF PARAMETERS IN MCRGENE */
if (n < 1000) {
/* noct = (mcrgene_1.ncore - n) * 48; */
noct = (mcrgene_.ncore - n) * 12 * sizeof(long int);
AdvApp2Var_SysBase::mcrfill_((integer *)&noct,
(char *)&mcrgene_.icore[(n + 1) * 12 - 12],
(char *)&mcrgene_.icore[n * 12 - 12]);
}
--mcrgene_.ncore;
/* *** Set to overflow of IOFSET */
*iofset = 2147483647;
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**********************************************************************
*/
//=======================================================================
//function : AdvApp2Var_SysBase::mcrfill_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::mcrfill_(integer *size,
char *tin,
char *tout)
{
if (mcrfill_ABS(tout-tin) >= *size)
memcpy( tout, tin, *size);
else if (tin > tout)
{
register integer n = *size;
register char *jmin=tin;
register char *jmout=tout;
while (n-- > 0) *jmout++ = *jmin++;
}
else
{
register integer n = *size;
register char *jmin=tin+n;
register char *jmout=tout+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 */
/* */
/* */
/*........................................................................*/
/* */
//=======================================================================
//function : mcrfree_
//purpose :
//=======================================================================
int mcrfree_(integer *,//ibyte,
uinteger *iadr,
integer *ier)
{
*ier=0;
free((void*)*iadr);
if ( !*iadr ) *ier = 1;
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 ==> Ofset > 2**31 - 1 */
/* */
/* */
/*........................................................................*/
//=======================================================================
//function : mcrgetv_
//purpose :
//=======================================================================
int mcrgetv_(integer *sz,
uinteger *iad,
integer *ier)
{
*ier = 0;
*iad = (uinteger)malloc(*sz);
if ( !*iad ) *ier = 1;
return 0;
}
//=======================================================================
//function : mcrlist_
//purpose :
//=======================================================================
int mcrlist_(integer *ier)
{
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Local variables */
static char cfmt[1];
static doublereal dfmt;
static integer ifmt, i__, nufmt, ntotal;
static 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__ = 1; i__ <= i__1; ++i__) {
nufmt = 2;
ifmt = mcrgene_.icore[i__ * 12 - 11] * mcrgene_.icore[i__ * 12 - 10]
;
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_ */
//=======================================================================
//function : mcrlocv_
//purpose :
//=======================================================================
int mcrlocv_(long int t,
long int *l)
{
*l = t;
return 0 ;
}
//=======================================================================
//function : AdvApp2Var_SysBase::mcrrqst_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::mcrrqst_(integer *iunit,
integer *isize,
doublereal *t,
long int *iofset,
integer *iercod)
{
integer i__1, i__2;
/* Local variables */
static doublereal dfmt;
static integer ifmt, iver;
static char subr[7];
static integer ksys , ibyte, irest, isyst, ier;
static long int iadfd, iadff, iaddr,lofset, loc;
static 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 */
/* ----------------------------------------------------------------------*
*/
/* Parameter adjustments */
--t;
/* Function Body */
*iercod = 0;
if (mcrgene_.ncore >= 1000) {
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) {
//s__wsle(&io___3);
//do__lio(&c__9, &c__1, "Require zero allocation", 26L);
AdvApp2Var_SysBase::e__wsle();
maostrb_();
} else if (ibyte >= 4096000) {
//s__wsle(&io___4);
//do__lio(&c__9, &c__1, "Require allocation above 4 Mega-Octets : ", 50L);
//do__lio(&c__3, &c__1, (char *)&ibyte, (ftnlen)sizeof(integer));
AdvApp2Var_SysBase::e__wsle();
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 */
mcrlocv_((long int)&t[1], (long int *)&loc);
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 alignement */
/* . add 16 octets for two flags */
ibyte = izu + 24;
/* DEMAND OF ALLOCATION */
isyst = 0;
/* 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 = 2;
mcrgetv_((integer *)&ibyte, (uinteger *)&iaddr, (integer *)&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_.ncore;
mcrgene_.icore[mcrgene_.ncore * 12 - 12] = mcrgene_.lprot;
mcrgene_.icore[mcrgene_.ncore * 12 - 11] = *iunit;
mcrgene_.icore[mcrgene_.ncore * 12 - 10] = *isize;
mcrgene_.icore[mcrgene_.ncore * 12 - 9] = loc;
mcrgene_.icore[mcrgene_.ncore * 12 - 8] = *iofset;
mcrgene_.icore[mcrgene_.ncore * 12 - 7] = ksys;
mcrgene_.icore[mcrgene_.ncore * 12 - 6] = ibyte;
mcrgene_.icore[mcrgene_.ncore * 12 - 5] = iaddr;
mcrgene_.icore[mcrgene_.ncore * 12 - 4] = mcrgene_.ncore;
mcrgene_.icore[mcrgene_.ncore * 12 - 3] = iadfd;
mcrgene_.icore[mcrgene_.ncore * 12 - 2] = iadff;
mcrgene_.icore[mcrgene_.ncore * 12 - 1] = mcrgene_.ncore;
mcrgene_.lprot = 0;
/* CALL ALLOWING AUTOIMPLEMENTATION OF THE SET WATCH BY THE DEBUGGER */
macrstw_((integer *)&iadfd, (integer *)&iadff, (integer *)&mcrgene_.ncore);
/* STATISTICS */
++mcrstac_.nrqst[ksys - 1];
mcrstac_.nbyte[ksys - 1] += mcrgene_.icore[mcrgene_.ncore * 12 - 11] *
mcrgene_.icore[mcrgene_.ncore * 12 - 10];
/* Computing MAX */
i__1 = mcrstac_.mbyte[ksys - 1], i__2 = mcrstac_.nbyte[ksys - 1];
mcrstac_.mbyte[ksys - 1] = max(i__1,i__2);
goto L9900;
/* ----------------------------------------------------------------------*
*/
/* ERROR PROCESSING */
/* MAX NB OF ALLOC REACHED : */
L9001:
*iercod = 1;
ifmt = 1000;
//__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_ */
//=======================================================================
//function : AdvApp2Var_SysBase::mgenmsg_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::mgenmsg_(const char *,//nomprg,
ftnlen )//nomprg_len)
{
return 0;
} /* mgenmsg_ */
//=======================================================================
//function : AdvApp2Var_SysBase::mgsomsg_
//purpose :
//=======================================================================
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***********************************************************************
*/
//=======================================================================
//function : AdvApp2Var_SysBase::miraz_
//purpose :
//=======================================================================
void AdvApp2Var_SysBase::miraz_(integer *taille,
char *adt)
{
integer offset;
offset = *taille;
memset(adt , '\0' , *taille) ;
}
//=======================================================================
//function : AdvApp2Var_SysBase::mnfndeb_
//purpose :
//=======================================================================
integer AdvApp2Var_SysBase::mnfndeb_()
{
integer ret_val;
ret_val = 0;
return ret_val;
} /* mnfndeb_ */
//=======================================================================
//function : AdvApp2Var_SysBase::mnfnimp_
//purpose :
//=======================================================================
integer AdvApp2Var_SysBase::mnfnimp_()
{
integer ret_val;
ret_val = 6;
return ret_val;
} /* mnfnimp_ */
//=======================================================================
//function : AdvApp2Var_SysBase::msifill_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::msifill_(integer *nbintg,
integer *ivecin,
integer *ivecou)
{
static 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_((integer *)&nocte, (char *)&ivecin[1], (char *)&ivecou[1]);
return 0 ;
} /* msifill_ */
//=======================================================================
//function : AdvApp2Var_SysBase::msrfill_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::msrfill_(integer *nbreel,
doublereal *vecent,
doublereal * vecsor)
{
static 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 << 3;
AdvApp2Var_SysBase::mcrfill_((integer *)&nocte, (char *)&vecent[1], (char *)&vecsor[1]);
return 0 ;
} /* msrfill_ */
//=======================================================================
//function : AdvApp2Var_SysBase::mswrdbg_
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::mswrdbg_(const char *,//ctexte,
ftnlen )//ctexte_len)
{
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* ***********************************************************************
*/
/* 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) {
io___1.ciunit = AdvApp2Var_SysBase::mnfnimp_();
//s__wsle(&io___1);
//do__lio(&c__9, &c__1, "Dbg ", 4L);
//do__lio(&c__9, &c__1, ctexte, ctexte_len);
AdvApp2Var_SysBase::e__wsle();
}
return 0 ;
} /* mswrdbg_ */
int __i__len()
{
return 0;
}
int __s__cmp()
{
return 0;
}
//=======================================================================
//function : do__fio
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::do__fio()
{
return 0;
}
//=======================================================================
//function : do__lio
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::do__lio ()
{
return 0;
}
//=======================================================================
//function : e__wsfe
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::e__wsfe ()
{
return 0;
}
//=======================================================================
//function : e__wsle
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::e__wsle ()
{
return 0;
}
//=======================================================================
//function : s__wsfe
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::s__wsfe ()
{
return 0;
}
//=======================================================================
//function : s__wsle
//purpose :
//=======================================================================
int AdvApp2Var_SysBase::s__wsle ()
{
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***********************************************************************
*/
//=======================================================================
//function : AdvApp2Var_SysBase::mvriraz_
//purpose :
//=======================================================================
void AdvApp2Var_SysBase::mvriraz_(integer *taille,
char *adt)
{
integer offset;
offset = *taille * 8 ;
/* printf(" adt %d long %d\n",adt,offset); */
memset(adt , '\0' , offset) ;
}
View Git Blame Copy Permalink