integer ier;
intptr_t iofset, j;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALISATION */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATION */
+ /* ***********************************************************************/
/* Parameter adjustment */
--point2;
iofset = 0;
ier = 0;
- /* ***********************************************************************
- */
- /* TRAITEMENT */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* TRAITEMENT */
+ /* ***********************************************************************/
AdvApp2Var_SysBase anAdvApp2Var_SysBase;
if (*ndimen > 100)
*distan = AdvApp2Var_MathBase::mzsnorm_(ndimen, &differ[iofset]);
}
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* **********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* **********************************************************************/
/* --- Dynamic Desallocation */
integer ipair, nd, ndegre, impair, ibb, idg;
// extern int mgsomsg_();//mgenmsg_(),
- /* **********************************************************************
- */
+ /* **********************************************************************/
/* FUNCTION : */
/* ---------- */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
- /* CRVNEW : Curve compacted in (0:(NCOEFF-1)/2,0,NDIM) (containing
- */
+ /* CRVNEW : Curve compacted in (0:(NCOEFF-1)/2,0,NDIM) (containing */
/* even terms) and in (0:(NCOEFF-1)/2,1,NDIM) */
/* (containing uneven terms). */
doublereal bidon;
integer ii, nd;
- /* ***********************************************************************
- */
+ /* **********************************************************************/
/* FUNCTION : */
/* ---------- */
/* Calculate the max error of approximation done when */
- /* only the first NCFNEW coefficients of a curve are preserved.
- */
+ /* only the first NCFNEW coefficients of a curve are preserved. */
/* Degree NCOEFF-1 written in the base of Legendre (Jacobi */
/* of order 0). */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
- /* YCVMAX : Auxiliary Table (max error on each dimension).
- */
+ /* YCVMAX : Auxiliary Table (max error on each dimension). */
/* ERRMAX : Precision of the approximation. */
/* COMMONS USED : */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* ***********************************************************************
- */
+ /* **********************************************************************/
- /* ------------------- Init to calculate an error -----------------------
- */
+ /* ------------------- Init to calculate an error --------------------- */
/* Parameter adjustments */
--ycvmax;
/* L100: */
}
- /* ------ Minimum that can be reached : Stop at 1 or NCFNEW ------
- */
+ /* ------ Minimum that can be reached : Stop at 1 or NCFNEW ------ */
ncut = 1;
if (*ncfnew + 1 > ncut)
ncut = *ncfnew + 1;
}
- /* -------------- Elimination of high degree coefficients-----------
- */
- /* ----------- Loop on the series of Legendre: NCUT --> NCOEFF --------
- */
+ /* -------------- Elimination of high degree coefficients----------- */
+ /* ----------- Loop on the series of Legendre: NCUT --> NCOEFF ----- */
i__1 = *ncoeff;
for (ii = ncut; ii <= i__1; ++ii)
/* L300: */
}
- /* -------------- The error is the norm of the vector error ---------------
- */
+ /* -------------- The error is the norm of the vector error ------------- */
*errmax = AdvApp2Var_MathBase::mzsnorm_(ndimen, &ycvmax[1]);
- /* --------------------------------- Fin --------------------------------
- */
+ /* --------------------------------- Fin -------------------------------- */
return 0;
} /* mmaper0_ */
doublereal bidon;
integer ii, nd;
- /* ***********************************************************************
- */
+ /* **********************************************************************/
/* FONCTION : */
/* ---------- */
/* Calculate max approximation error i faite lorsque l' on */
- /* ne conserve que les premiers NCFNEW coefficients d' une courbe
- */
+ /* ne conserve que les premiers NCFNEW coefficients d' une courbe */
/* de degre NCOEFF-1 ecrite dans la base de Jacobi d' ordre 2. */
/* KEYWORDS : */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
- /* YCVMAX : Auxiliary Table (max error on each dimension).
- */
+ /* YCVMAX : Auxiliary Table (max error on each dimension). */
/* ERRMAX : Precision of the approximation. */
/* COMMONS USED : */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* ------------------ Table of maximums of (1-t2)*Ji(t) ----------------
- */
+ /* ------------------ Table of maximums of (1-t2)*Ji(t) ---------------- */
/* Parameter adjustments */
--ycvmax;
/* Function Body */
- /* ------------------- Init for error calculation -----------------------
- */
+ /* ------------------- Init for error calculation ---------------------- */
i__1 = *ndimen;
for (ii = 1; ii <= i__1; ++ii)
/* L100: */
}
- /* ------ Min. Degree that can be attained : Stop at 3 or NCFNEW ------
- */
+ /* ------ Min. Degree that can be attained : Stop at 3 or NCFNEW ------ */
idec = 3;
/* Computing MAX */
i__1 = idec, i__2 = *ncfnew + 1;
ncut = advapp_max(i__1, i__2);
- /* -------------- Removal of coefficients of high degree -----------
- */
- /* ----------- Loop on the series of Jacobi :NCUT --> NCOEFF ----------
- */
+ /* -------------- Removal of coefficients of high degree -------------- */
+ /* ----------- Loop on the series of Jacobi :NCUT --> NCOEFF ---------- */
i__1 = *ncoeff;
for (ii = ncut; ii <= i__1; ++ii)
/* L300: */
}
- /* -------------- The error is the norm of the vector error ---------------
- */
+ /* -------------- The error is the norm of the vector error ------------ */
*errmax = AdvApp2Var_MathBase::mzsnorm_(ndimen, &ycvmax[1]);
- /* --------------------------------- Fin --------------------------------
- */
+ /* --------------------------------- Fin ------------------------------- */
return 0;
} /* mmaper2_ */
doublereal bidon;
integer ii, nd;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* Calculate the max. error of approximation made when */
- /* only first NCFNEW coefficients of a curve are preserved
- */
+ /* only first NCFNEW coefficients of a curve are preserved */
/* degree NCOEFF-1 is written in the base of Jacobi of order 4. */
/* KEYWORDS : */
/* ----------- */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
- /* YCVMAX : Auxiliary Table (max error on each dimension).
- */
+ /* YCVMAX : Auxiliary Table (max error on each dimension). */
/* ERRMAX : Precision of the approximation. */
/* COMMONS USED : */
/* DESCRIPTION/NOTES/LIMITATIONS : */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ---------------- Table of maximums of ((1-t2)2)*Ji(t) ---------------
- */
+ /* ---------------- Table of maximums of ((1-t2)2)*Ji(t) --------------- */
/* Parameter adjustments */
--ycvmax;
/* Function Body */
- /* ------------------- Init for error calculation -----------------------
- */
+ /* ------------------- Init for error calculation ---------------------- */
i__1 = *ndimen;
for (ii = 1; ii <= i__1; ++ii)
/* L100: */
}
- /* ------ Min. Degree that can be attained : Stop at 5 or NCFNEW ------
- */
+ /* ------ Min. Degree that can be attained : Stop at 5 or NCFNEW ------- */
idec = 5;
/* Computing MAX */
i__1 = idec, i__2 = *ncfnew + 1;
ncut = advapp_max(i__1, i__2);
- /* -------------- Removal of high degree coefficients -----------
- */
- /* ----------- Loop on the series of Jacobi :NCUT --> NCOEFF ----------
- */
+ /* -------------- Removal of high degree coefficients ------------------ */
+ /* ----------- Loop on the series of Jacobi :NCUT --> NCOEFF ----------- */
i__1 = *ncoeff;
for (ii = ncut; ii <= i__1; ++ii)
/* L300: */
}
- /* -------------- The error is the norm of the error vector ---------------
- */
+ /* -------------- The error is the norm of the error vector ------------ */
*errmax = AdvApp2Var_MathBase::mzsnorm_(ndimen, &ycvmax[1]);
- /* --------------------------------- End --------------------------------
- */
+ /* --------------------------------- End ------------------------------- */
return 0;
} /* mmaper4_ */
doublereal bidon;
integer ii, nd;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* Calculate the max. error of approximation made when */
- /* only first NCFNEW coefficients of a curve are preserved
- */
+ /* only first NCFNEW coefficients of a curve are preserved */
/* degree NCOEFF-1 is written in the base of Jacobi of order 6. */
/* KEYWORDS : */
/* ----------- */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
- /* YCVMAX : Auxiliary Table (max error on each dimension).
- */
+ /* YCVMAX : Auxiliary Table (max error on each dimension). */
/* ERRMAX : Precision of the approximation. */
/* COMMONS USED : */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ---------------- Table of maximums of ((1-t2)3)*Ji(t) ---------------
- */
+ /* ---------------- Table of maximums of ((1-t2)3)*Ji(t) --------------- */
/* Parameter adjustments */
--ycvmax;
/* Function Body */
- /* ------------------- Init for error calculation -----------------------
- */
+ /* ------------------- Init for error calculation ---------------------- */
i__1 = *ndimen;
for (ii = 1; ii <= i__1; ++ii)
/* L100: */
}
- /* ------ Min Degree that can be attained : Stop at 3 or NCFNEW ------
- */
+ /* ------ Min Degree that can be attained : Stop at 3 or NCFNEW -------- */
idec = 7;
/* Computing MAX */
i__1 = idec, i__2 = *ncfnew + 1;
ncut = advapp_max(i__1, i__2);
- /* -------------- Removal of high degree coefficients -----------
- */
- /* ----------- Loop on the series of Jacobi :NCUT --> NCOEFF ----------
- */
+ /* -------------- Removal of high degree coefficients ------------------ */
+ /* ----------- Loop on the series of Jacobi :NCUT --> NCOEFF ----------- */
i__1 = *ncoeff;
for (ii = ncut; ii <= i__1; ++ii)
/* L300: */
}
- /* -------------- The error is the norm of the vector error ---------------
- */
+ /* -------------- The error is the norm of the vector error ------------ */
*errmax = AdvApp2Var_MathBase::mzsnorm_(ndimen, &ycvmax[1]);
- /* --------------------------------- END --------------------------------
- */
+ /* --------------------------------- END ------------------------------- */
return 0;
} /* mmaper6_ */
/* Local variables */
integer jord;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* Calculate the max. error of approximation made when */
- /* only first NCFNEW coefficients of a curve are preserved
- */
+ /* only first NCFNEW coefficients of a curve are preserved */
/* degree NCOEFF-1 is written in the base of Jacobi of order IORDRE. */
/* KEYWORDS : */
/* ----------- */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
- /* YCVMAX : Auxiliary Table (max error on each dimension).
- */
+ /* YCVMAX : Auxiliary Table (max error on each dimension). */
/* ERRMAX : Precision of the approximation. */
/* IERCOD = 0, OK */
/* = 1, order of constraints (IORDRE) is not within the */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* Canceled and replaced MMAPERR. */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--ycvmax;
*iercod = 1;
}
- /* ----------------------------------- Fin ------------------------------
- */
+ /* ----------------------------------- Fin ----------------------------- */
return 0;
} /* mmaperx_ */
/* IMPLICIT DOUBLE PRECISION(A-H,O-Z) */
/* IMPLICIT INTEGER (I-N) */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* NDIMEN : Curve Dimension. */
/* NCOEFF : Nb of coefficients of the curve. */
/* CRVOLD : Curve to be limited. */
- /* UPARA0 : Min limit of the interval limiting the curve.
- */
- /* UPARA1 : Max limit of the interval limiting the curve.
- */
+ /* UPARA0 : Min limit of the interval limiting the curve. */
+ /* UPARA1 : Max limit of the interval limiting the curve. */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* ---> Algorithm used in this general case is based on the */
- /* following principle : */
+ /* following principle : */
/* Let S(t) = a0 + a1*t + a2*t**2 + ... of degree NCOEFF-1, and */
/* U(t) = b0 + b1*t, then the coeff. of */
/* S(U(t)) are calculated step by step with help of table TBAUX. */
/* is absolutely LEGAL. (RBD) */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
/* Function Body */
*iercod = 0;
- /* **********************************************************************
- */
- /* CASE WHEN PROCESSING CAN'T BE DONE */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* CASE WHEN PROCESSING CAN'T BE DONE */
+ /* ***********************************************************************/
if (*ncoeff > 61 || *ncoeff < 1)
{
*iercod = 10;
goto L9999;
}
- /* **********************************************************************
- */
- /* IF NO CHANGES */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* IF NO CHANGES */
+ /* ***********************************************************************/
if (*ndimen == *ndimax && *upara0 == 0. && *upara1 == 1.)
{
nboct = (*ndimax << 3) * *ncoeff;
AdvApp2Var_SysBase::mcrfill_(&nboct, &crvold[crvold_offset], &crvnew[crvnew_offset]);
goto L9999;
}
- /* **********************************************************************
- */
- /* INVERSION 3D : FAST PROCESSING */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* INVERSION 3D : FAST PROCESSING */
+ /* ***********************************************************************/
if (*upara0 == 1. && *upara1 == 0.)
{
if (*ndimen == 3 && *ndimax == 3 && *ncoeff <= 21)
mvcvinv_(ncoeff, &crvold[crvold_offset], &crvnew[crvnew_offset], iercod);
goto L9999;
}
- /* ******************************************************************
- **** */
- /* INVERSION 2D : FAST PROCESSING */
- /* ******************************************************************
- **** */
+ /* *********************************************************************/
+ /* INVERSION 2D : FAST PROCESSING */
+ /* *********************************************************************/
if (*ndimen == 2 && *ndimax == 2 && *ncoeff <= 21)
{
mvcvin2_(ncoeff, &crvold[crvold_offset], &crvnew[crvnew_offset], iercod);
goto L9999;
}
}
- /* **********************************************************************
- */
- /* GENERAL PROCESSING */
- /* **********************************************************************
- */
- /* -------------------------- Initializations ---------------------------
- */
+ /* ***********************************************************************/
+ /* GENERAL PROCESSING */
+ /* ***********************************************************************/
+ /* -------------------------- Initializations -------------------------- */
i__1 = *ndimen;
for (nd = 1; nd <= i__1; ++nd)
tbaux[0] = *upara0;
tbaux[1] = *upara1 - *upara0;
- /* ----------------------- Calculation of coeff. of CRVNEW ------------------
- */
+ /* ----------------------- Calculation of coeff. of CRVNEW ------------- */
i__1 = *ncoeff - 1;
for (ncf = 2; ncf <= i__1; ++ncf)
{
- /* ------------ Take into account NCF-th coeff. of CRVOLD --------
- ---- */
+ /* ------------ Take into account NCF-th coeff. of CRVOLD ------------ */
i__2 = ncf - 1;
for (ncj = 1; ncj <= i__2; ++ncj)
/* L500: */
}
- /* --------- Calculate (NCF+1) coeff. of ((U1-U0)*t + U0)**(NCF) ---
- ---- */
+ /* --------- Calculate (NCF+1) coeff. of ((U1-U0)*t + U0)**(NCF) ----- */
bid = *upara1 - *upara0;
tbaux[ncf] = tbaux[ncf - 1] * bid;
/* L200: */
}
- /* -------------- Take into account the last coeff. of CRVOLD -----------
- */
+ /* -------------- Take into account the last coeff. of CRVOLD ---------- */
i__1 = *ncoeff - 1;
for (ncj = 1; ncj <= i__1; ++ncj)
/* L900: */
}
- /* ---------------------------- The end ---------------------------------
- */
+ /* ---------------------------- The end -------------------------------- */
L9999:
if (*iercod != 0)
integer ncj;
doublereal eps3;
- /* **********************************************************************
- *//* FUNCTION : */
+ /* ***********************************************************************/
+ /* FUNCTION : */
/* ---------- */
/* Creation of curve C2(v) defined on [U0,U1] identic to */
/* curve C1(u) defined on [-1,1] (change of parameter */
/* NDIMEN : Curve Dimension. */
/* NCOEFF : Nb of coefficients of the curve. */
/* CRVOLD : Curve to be limited. */
- /* U0 : Min limit of the interval limiting the curve.
- */
- /* U1 : Max limit of the interval limiting the curve.
- */
+ /* U0 : Min limit of the interval limiting the curve. */
+ /* U1 : Max limit of the interval limiting the curve. */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
}
*iercod = 0;
- /* **********************************************************************
- */
- /* CASE WHEN THE PROCESSING IS IMPOSSIBLE */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* CASE WHEN THE PROCESSING IS IMPOSSIBLE */
+ /* ***********************************************************************/
if (*ncoeff > 61 || *ncoeff < 1)
{
*iercod = 10;
goto L9999;
}
- /* **********************************************************************
- */
- /* IF NO CHANGE OF THE INTERVAL OF DEFINITION */
- /* (ONLY INVERSION OF INDICES OF TABLE CRVOLD) */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* IF NO CHANGE OF THE INTERVAL OF DEFINITION */
+ /* (ONLY INVERSION OF INDICES OF TABLE CRVOLD) */
+ /* ***********************************************************************/
if (*ndim == *ndimax && *u0 == -1. && *u1 == 1.)
{
AdvApp2Var_MathBase::mmcvinv_(ndim,
&crvnew[crvnew_offset]);
goto L9999;
}
- /* **********************************************************************
- */
- /* CASE WHEN THE NEW INTERVAL OF DEFINITION IS [0,1] */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* CASE WHEN THE NEW INTERVAL OF DEFINITION IS [0,1] */
+ /* ***********************************************************************/
if (*u0 == 0. && *u1 == 1.)
{
mmcvstd_(ncoeff, ndimax, ncoeff, ndim, &crvold[crvold_offset], &crvnew[crvnew_offset]);
goto L9999;
}
- /* **********************************************************************
- */
- /* GENERAL PROCESSING */
- /* **********************************************************************
- */
- /* -------------------------- Initialization ---------------------------
- */
+ /* ***********************************************************************/
+ /* GENERAL PROCESSING */
+ /* ***********************************************************************/
+ /* -------------------------- Initialization --------------------------- */
x0 = -(*u1 + *u0) / (*u1 - *u0);
x1 = 2. / (*u1 - *u0);
tabaux[0] = x0;
tabaux[1] = x1;
- /* ----------------------- Calculation of coeff. of CRVNEW ------------------
- */
+ /* ----------------------- Calculation of coeff. of CRVNEW ------------- */
i__1 = *ncoeff - 1;
for (ncf = 2; ncf <= i__1; ++ncf)
{
- /* ------------ Take into account the NCF-th coeff. of CRVOLD --------
- ---- */
+ /* ------------ Take into account the NCF-th coeff. of CRVOLD -------- */
i__2 = ncf - 1;
for (ncj = 1; ncj <= i__2; ++ncj)
/* L500: */
}
- /* --------- Calculation of (NCF+1) coeff. of [X1*t + X0]**(NCF) --------
- ---- */
+ /* --------- Calculation of (NCF+1) coeff. of [X1*t + X0]**(NCF) ----- */
tabaux[ncf] = tabaux[ncf - 1] * x1;
for (ncj = ncf; ncj >= 2; --ncj)
/* L200: */
}
- /* -------------- Take into account the last coeff. of CRVOLD -----------
- */
+ /* -------------- Take into account the last coeff. of CRVOLD ---------- */
i__1 = *ncoeff - 1;
for (ncj = 1; ncj <= i__1; ++ncj)
/* L900: */
}
- /* ---------------------------- The end ---------------------------------
- */
+ /* ---------------------------- The end -------------------------------- */
L9999:
if (*iercod > 0)
doublereal somme;
integer aux;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALISATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
--vecout;
}
*iercod = 0;
- /* ***********************************************************************
- */
- /* Processing */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* Processing */
+ /* ***********************************************************************/
AdvApp2Var_SysBase::mvriraz_(nligne, &vecout[1]);
i__1 = *nligne;
for (i__ = *deblig; i__ <= i__1; ++i__)
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
doublereal daux;
integer nite1, nite2, nchan, i1, i2;
- /* ***********************************************************************
- */
+ /* ************************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* Particularly performant if the table is almost parsed */
/* In the opposite case it is better to use MVSHELD */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
dtabtr_dim1 = *nblign;
nite1 = *nbcoln;
nite2 = 2;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
/* ---->ALGORITHM in N^2 / 2 additional iteration */
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
/* ----> No errors at calling functions, only tests and loops. */
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
integer i__, j, k;
doublereal mfactk, bid;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* NCOEFF : they are not set to zero. */
/* ---> Algorithm : */
- /* The code below was written basing on the following algorithm:
- */
+ /* The code below was written basing on the following algorithm: */
/* Let P(t) = a1 + a2*t + ... an*t**n. Derivate of order k of P */
/* (containing n-k coefficients) is calculated as follows : */
/* . */
/* . */
/* + a(n)*CNP(n-1,k)*k! * t**(n-k-1). */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* -------------- Case when the order of derivative is -------------------
- */
- /* ---------------- greater than the degree of the curve ---------------------
- */
+ /* -------------- Case when the order of derivative is ---------------- */
+ /* ---------------- greater than the degree of the curve --------------- */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* Binomial coeff from 0 to 60. read only . init par block data */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* Binomial coefficients form a triangular matrix. */
/* This matrix is completed in table CNP by its transposition. */
/* Initialization is done by block-data MMLLL09.RES, */
/* created by program MQINICNP.FOR). */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
crvdrv_dim1 = *ndimen;
*ncofdv = 1;
goto L9999;
}
- /* **********************************************************************
- */
- /* General processing */
- /* **********************************************************************
- */
- /* --------------------- Calculation of Factorial(IDERIV) ------------------
- */
+ /* ***********************************************************************/
+ /* General processing */
+ /* ***********************************************************************/
+ /* --------------------- Calculation of Factorial(IDERIV) -------------- */
k = *ideriv;
mfactk = 1.;
/* L50: */
}
- /* ------------ Calculation of coeff of the derived of order IDERIV ----------
- */
+ /* ------------ Calculation of coeff of the derived of order IDERIV ---- */
/* ---> Attention : coefficient binomial C(n,m) is represented in */
/* MCCNP by CNP(N+1,M+1). */
*ncofdv = *ncoeff - *ideriv;
- /* -------------------------------- The end -----------------------------
- */
+ /* -------------------------------- The end ---------------------------- */
L9999:
return 0;
doublereal dif, pas;
doublereal som;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* NDIMAX : Max. number of lines of tables */
/* (i.e. max. nb of polynoms). */
/* NDIMEN : Dimension of the space (nb of polynoms). */
- /* NCOEFF : Nb of coefficients of the polynom. This is degree + 1.
- */
+ /* NCOEFF : Nb of coefficients of the polynom. This is degree + 1. */
/* COURBE(NDIMAX,NCOEFF) : Coefficients of the curve. */
/* TDEBUT : Lower limit of the interval of integration for */
/* length calculation. */
/* ATTENTION : if TDEBUT > TFINAL, the length is NEGATIVE. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
- /* ------------------------ General Initialization ---------------------
- */
+ /* ------------------------ General Initialization --------------------- */
/* Parameter adjustments */
courbe_dim1 = *ndimax;
doublereal somme;
integer ptini, ptcou;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
- /* ---------- T */
+ /* ---------- */
/* Produce decomposition of choleski of matrix A in S.S */
/* Calculate inferior triangular matrix S. */
/* MXCOEF : Max number of terms in the hessian profile */
/* DIMENS : Dimension of the problem */
/* AMATRI(MXCOEF) : Coefficients of the matrix profile */
- /* APOSIT(1,*) : Distance diagonal-left extremity of the line
- */
+ /* APOSIT(1,*) : Distance diagonal-left extremity of the line */
/* APOSIT(2,*) : Position of diagonal terms in HESSIE */
/* POSUIV(MXCOEF) : first line inferior not out of profile */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* DEBUG LEVEL = 4 */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALISATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
--chomat;
}
*iercod = 0;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
i__1 = *dimens;
for (j = 1; j <= i__1; ++j)
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
goto L9999;
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
integer ibb, ncf, ndv;
doublereal eps1;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* This routine returns a curve defined in (-1,1). */
/* In general case, it is necessary to use MCVCTG. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
/* Precision. */
AdvApp2Var_MathBase::mmeps1_(&eps1);
- /* ****************** CALCULATION OF EVEN COEFFICIENTS *********************
- */
- /* ------------------------- Initialization -----------------------------
- */
+ /* ****************** CALCULATION OF EVEN COEFFICIENTS *******************/
+ /* ------------------------- Initialization ---------------------------- */
nordr = *nderiv + 1;
i__1 = nordr;
/* L100: */
}
- /* ---------------- Calculation of terms corresponding to derivatives -------
- */
+ /* ---------------- Calculation of terms corresponding to derivatives -- */
i__1 = nordr;
for (ndv = 2; ndv <= i__1; ++ndv)
/* L200: */
}
- /* ------------------ Writing the second member -----------------------
- */
+ /* ------------------ Writing the second member ------------------------ */
moup1 = 1;
i__1 = nordr;
/* L400: */
}
- /* -------------------- Resolution of the system ---------------------------
- */
+ /* -------------------- Resolution of the system ----------------------- */
mmrslw_(&nordr, &nordr, ndimen, &eps1, &tabaux[tabaux_offset], &xmatri[xmatri_offset], iercod);
if (*iercod > 0)
/* L600: */
}
- /* ***************** CALCULATION OF UNEVEN COEFFICIENTS ********************
- */
- /* ------------------------- Initialization -----------------------------
- */
+ /* ***************** CALCULATION OF UNEVEN COEFFICIENTS *******************/
+ /* ------------------------- Initialization ----------------------------- */
i__1 = nordr;
for (ncf = 1; ncf <= i__1; ++ncf)
/* L1100: */
}
- /* ---------------- Calculation of terms corresponding to derivatives -------
- */
+ /* ---------------- Calculation of terms corresponding to derivatives -- */
i__1 = nordr;
for (ndv = 2; ndv <= i__1; ++ndv)
/* L1200: */
}
- /* ------------------ Writing of the second member -----------------------
- */
+ /* ------------------ Writing of the second member --------------------- */
moup1 = -1;
i__1 = nordr;
/* L1400: */
}
- /* -------------------- Solution of the system ---------------------------
- */
+ /* -------------------- Solution of the system ------------------------- */
mmrslw_(&nordr, &nordr, ndimen, &eps1, &tabaux[tabaux_offset], &xmatri[xmatri_offset], iercod);
if (*iercod > 0)
/* L1600: */
}
- /* --------------------------- The end ----------------------------------
- */
+ /* --------------------------- The end --------------------------------- */
L9999:
if (*iercod != 0)
/* Local variables */
integer i__, nd, ibb;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* The name of the routine */
/* Parameter adjustments */
integer ndeg, i__, j, j1, nd, ibb;
doublereal bid;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the program. */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* Binomial coefficient from 0 to 60. read only . init by block data */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* Binomial coefficients form a triangular matrix. */
/* This matrix is completed in table CNP by its transposition. */
/* Initialization is done with block-data MMLLL09.RES, */
/* created by the program MQINICNP.FOR. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
courbe_dim1 = *ndimax;
}
ndeg = *ncoeff - 1;
- /* ------------------ Construction of the resulting curve ----------------
- */
+ /* ------------------ Construction of the resulting curve -------------- */
i__1 = *ndimen;
for (nd = 1; nd <= i__1; ++nd)
/* L300: */
}
- /* ------------------- Renormalization of the CURVE -------------------------
- */
+ /* ------------------- Renormalization of the CURVE -------------------- */
bid = 1.;
i__1 = ndeg;
/* L500: */
}
- /* ----------------------------- The end --------------------------------
- */
+ /* ----------------------------- The end ------------------------------- */
if (ibb >= 3)
{
integer ndeg, i__, j, ndgcb, nd, ibb;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ------------------- */
/* POINTS : Table of values of consecutive derivatives */
/* of parameters -1.D0 and 1.D0. */
- /* MFACTAB : Auxiliary table for calculation of factorial(I).
- */
+ /* MFACTAB : Auxiliary table for calculation of factorial(I). */
/* COMMONS USED : */
/* ---------------- */
/* Addison-Wesley Pub. Co. (1969) */
/* pages 423-425. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
goto L9999;
}
- /* ------------------- Initialization of table POINTS -----------------
- */
+ /* ------------------- Initialization of table POINTS ------------------ */
ndgcb = *ncoeff - 1;
i__1 = *ndimen;
/* L600: */
}
- /* --------------------- Multiplication by factorial(I) --------------
- */
+ /* --------------------- Multiplication by factorial(I) ---------------- */
if (*iordre > 1)
{
}
}
- /* ---------------------------- End -------------------------------------
- */
+ /* ---------------------------- End ------------------------------------ */
L9999:
if (ibb >= 2)
/* ---> To evaluare derivatives at 0 and 1, it is preferable */
/* to use routine MDRV01.FOR . */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
}
*iercod = 0;
- /* ------------------- Initialization of table TABPNT -----------------
- */
+ /* ------------------- Initialization of table TABPNT ------------------ */
ndgcrb = *ncoeff - 1;
i__1 = *ndim;
AdvApp2Var_SysBase::mvriraz_(&iptpnt, &tabpnt[tabpnt_dim1 + 1]);
L200:
- /* ------------------------ Calculation of parameter TPARAM ------------------
- */
+ /* ------------------------ Calculation of parameter TPARAM ------------ */
i__1 = ndgcrb;
for (ndeg = 1; ndeg <= i__1; ++ndeg)
/* L500: */
}
- /* --------------------- Multiplication by factorial(I) -------------
- */
+ /* --------------------- Multiplication by factorial(I) ---------------- */
i__1 = *ideriv;
for (i__ = 2; i__ <= i__1; ++i__)
/* L1000: */
}
- /* --------------------------- The end ---------------------------------
- */
+ /* --------------------------- The end --------------------------------- */
L9999:
if (*iercod > 0)
/* IMPLICIT INTEGER (I-N) */
/* IMPLICIT DOUBLE PRECISION(A-H,O-Z) */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FONCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* The code below was written basing on the following algorithm :
- */
+ /* The code below was written basing on the following algorithm : */
/* Let P(t) = a1 + a2*t + ... an*t**n. The derivative of order k of P */
/* (containing n-k coefficients) is calculated as follows : */
/* Evaluation is produced following the classic Horner scheme. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Factorials (1 to 21) calculated on VAX in R*16 */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* Binomial Coeff from 0 to 60. read only . init by block data */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* Binomial coefficients form a triangular matrix. */
/* This matrix is completed in table CNP by its transposition. */
/* Initialization is done by block-data MMLLL09.RES, */
/* created by program MQINICNP.FOR. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--pntcrb;
/* Function Body */
- /* -------------- Case when the order of derivative is greater than -------------------
- */
- /* ---------------- the degree of the curve ---------------------
- */
+ /* -------------- Case when the order of derivative is greater than ---- */
+ /* ---------------- the degree of the curve ---------------------------- */
if (*ideriv >= *ncoeff)
{
}
goto L9999;
}
- /* **********************************************************************
- */
- /* General processing*/
- /* **********************************************************************
- */
- /* --------------------- Calculation of Factorial(IDERIV) ------------------
- */
+ /* ***********************************************************************/
+ /* General processing */
+ /* ***********************************************************************/
+ /* --------------------- Calculation of Factorial(IDERIV) -------------- */
k = *ideriv;
if (*ideriv <= 21 && *ideriv > 0)
}
}
- /* ------- Calculation of derivative of order IDERIV of CURVE in TPARAM -----
- */
+ /* ----- Calculation of derivative of order IDERIV of CURVE in TPARAM -- */
/* ---> Attention : binomial coefficient C(n,m) is represented in */
/* MCCNP by CNP(N,M). */
/* L400: */
}
- /* -------------------------------- The end -----------------------------
- */
+ /* -------------------------------- The end ---------------------------- */
L9999:
int AdvApp2Var_MathBase::mmeps1_(doublereal* epsilo)
{
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* compared to EPS1**2. Taking into account the rounding errors inevitable */
/* during calculations, this causes testing compared to 0.D0. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* PARAMETER , TOLERANCE */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* INITIALISATION : profile , **VIA MPRFTX** at input in stream */
/* loading of default values of the profile in MPRFTX at input */
/* MEPSNR ... EPS2 , NITERM */
/* MITERR ... NITERR */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* NITERM : max nb of iterations */
/* NITERR : nb of rapid iterations */
/* EPS3 : tolerance to avoid division by 0.. */
/* EPS4 : angular tolerance */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
*epsilo = mmprcsn_.eps1;
return 0;
integer iadd, ideb, ndeg2, nmod2, ii, ibb;
integer kpt;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FONCTION : */
/* ---------- */
/* AND weights of Gauss quadrature formulas on all */
/* POSITIVE roots of Legendre polynoms. */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* > */
- /* ***********************************************************************
- */
+ /* > */
+ /* ***********************************************************************/
/* ROOTAB : Table of all roots of Legendre polynoms */
/* within the interval [0,1]. They are ranked for the degrees increasing from */
/* RTLTB1 : Table of Li(uk) where uk are the roots of */
/* Legendre polynom of UNEVEN degree. */
- /************************************************************************
- *****/
+ /*************************************************************************/
/* Function Body */
ibb = AdvApp2Var_SysBase::mnfndeb_();
hwgaus(ndeg2 + 1) = mlgdrtl_.hi0tab[ndeg2];
}
- /* --------------------------- The end ----------------------------------
- */
+ /* --------------------------- The end --------------------------------- */
if (ibb >= 3)
{
integer iadd, ideb, ndeg2, nmod2, ii, ibb;
integer kpt;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ATTENTION: Condition of NDEGRE ( 2 <= NDEGRE <= 61) is not */
/* tested. The caller should make the test. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
/* AND the weight of Gauss quadrature formulas on all */
/* POSITIVE roots of Legendre polynoms. */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* BASE LEGENDRE */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ROOTAB : Table of all roots of Legendre polynoms */
- /* within the interval [0,1]. They are ranked for the degrees increasing from */
- /* 2 to 61. */
+ /* within the interval [0,1]. They are ranked for the degrees */
+ /* increasing from 2 to 61. */
/* HILTAB : Table of Legendre interpolators concerning ROOTAB. */
/* The addressing is the same. */
/* HI0TAB : Table of Legendre interpolators for root x=0 */
/* RTLTB1 : Table of Li(uk) where uk are the roots of */
/* Legendre polynom of UNEVEN degree. */
- /************************************************************************
- *****/
+ /*************************************************************************/
/* Function Body */
ibb = AdvApp2Var_SysBase::mnfndeb_();
/* L100: */
}
- /* Strictly negative roots are equal to positive roots
- */
- /* to the sign i.e RT(1) = -RT(NDEGRE), RT(2) = -RT(NDEGRE-1), etc...
- */
+ /* Strictly negative roots are equal to positive roots */
+ /* to the sign i.e RT(1) = -RT(NDEGRE), RT(2) = -RT(NDEGRE-1), etc... */
i__1 = ndeg2;
for (ii = 1; ii <= i__1; ++ii)
rootlg(ndeg2 + 1) = 0.;
}
- /* -------------------------------- THE END -----------------------------
- */
+ /* -------------------------------- THE END ---------------------------- */
if (ibb >= 3)
{
/* Local variables */
integer i__, j, k, ilong;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* The following call : */
- /* CALL MMFMCA8(NDIMEN,NCOEFU,NCOEFV,NDIMAX,NCFUMX,NCFVMX,TABINI,TABINI)
- */
+ /* CALL MMFMCA8(NDIMEN,NCOEFU,NCOEFV,NDIMAX,NCFUMX,NCFVMX,TABINI,TABINI) */
/* where TABINI is input/output argument, is possible provided */
/* that the caller has declared TABINI in (NDIMAX,NCFUMX,NCFVMX) */
/* ATTENTION : it is not checked that NDIMAX >= NDIMEN, */
/* NCOEFU >= NCFMXU and NCOEFV >= NCFMXV. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
tabini_dim1 = *ndimen;
goto L1000;
}
- /* ----------------------- decompression NDIMAX<>NDIMEN -----------------
- */
+ /* ----------------------- decompression NDIMAX<>NDIMEN ---------------- */
for (k = *ncoefv; k >= 1; --k)
{
}
goto L9999;
- /* ----------------------- decompression NDIMAX=NDIMEN ------------------
- */
+ /* ----------------------- decompression NDIMAX=NDIMEN ----------------- */
L1000:
if (*ncoefu == *ncfumx)
AdvApp2Var_SysBase::mcrfill_(&ilong, &tabini[tabini_offset], &tabres[tabres_offset]);
goto L9999;
- /* ---------------------------- The end ---------------------------------
- */
+ /* ---------------------------- The end -------------------------------- */
L9999:
return 0;
/* Local variables */
integer i__, j, k, ilong;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* The following call : */
- /* CALL MMFMCA9(NDIMAX,NCFUMX,NCFVMX,NDIMEN,NCOEFU,NCOEFV,TABINI,TABINI)
- */
+ /* CALL MMFMCA9(NDIMAX,NCFUMX,NCFVMX,NDIMEN,NCOEFU,NCOEFV,TABINI,TABINI) */
/* where TABINI is input/output argument, is possible provided */
/* that the caller has checked that : */
/* These conditions are not tested in the program. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
tabini_dim1 = *ndimax;
goto L1000;
}
- /* ----------------------- Compression NDIMEN<>NDIMAX -------------------
- */
+ /* ----------------------- Compression NDIMEN<>NDIMAX ------------------ */
i__1 = *ncoefv;
for (k = 1; k <= i__1; ++k)
}
goto L9999;
- /* ----------------------- Compression NDIMEN=NDIMAX --------------------
- */
+ /* ----------------------- Compression NDIMEN=NDIMAX ------------------- */
L1000:
if (*ncoefu == *ncfumx)
}
goto L9999;
- /* ----------------- Compression NDIMEN=NDIMAX,NCOEFU=NCFUMX ------------
- */
+ /* ----------------- Compression NDIMEN=NDIMAX,NCOEFU=NCFUMX ----------- */
L2000:
ilong = (*ndimen << 3) * *ncoefu * *ncoefv;
AdvApp2Var_SysBase::mcrfill_(&ilong, &tabini[tabini_offset], &tabres[tabres_offset]);
goto L9999;
- /* ---------------------------- The end ---------------------------------
- */
+ /* ---------------------------- The end -------------------------------- */
L9999:
return 0;
intptr_t iofst;
integer ibb, ier;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* NCOFMX: MAX NUMBER OF COEFF OF THE SQUARE BY U */
/* NCOEFU: NUMBER OF COEFF OF THE SQUARE BY U */
/* NCOEFV: NUMBER OF COEFF OF THE SQUARE BY V */
- /* PATOLD : THE SQUARE IS LIMITED BY UPARA1,UPARA2 AND VPARA1,VPARA2
- .*/
- /* UPARA1 : LOWER LIMIT OF U */
- /* UPARA2 : UPPER LIMIT OF U */
- /* VPARA1 : LOWER LIMIT OF V */
- /* VPARA2 : UPPER LIMIT OF V */
+ /* PATOLD: THE SQUARE IS LIMITED BY UPARA1,UPARA2 AND VPARA1,VPARA2 */
+ /* UPARA1: LOWER LIMIT OF U */
+ /* UPARA2: UPPER LIMIT OF U */
+ /* VPARA1: LOWER LIMIT OF V */
+ /* VPARA2: UPPER LIMIT OF V */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* ---> The following call : */
- /* CALL MMFMCAR(NCOFMX,NCOEFU,NCOEFV,PATOLD,UPARA1,UPARA2,VPARA1,VPARA2
- */
+ /* CALL MMFMCAR(NCOFMX,NCOEFU,NCOEFV,PATOLD,UPARA1,UPARA2,VPARA1,VPARA2 */
/* ,PATOLD), */
/* where PATOLD is input/output argument is absolutely legal. */
/* ---> If NCOEFU < NCOFMX, the data is compressed by MMFMCA9 before */
/* limitation by v to get time during the execution */
- /* of MMARC41 that follows (the square is processed as a curve of
- */
+ /* of MMARC41 that follows (the square is processed as a curve of */
/* dimension NDIMEN*NCOEFU possessing NCOEFV coefficients). */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
iofst = 0;
AdvApp2Var_SysBase anAdvApp2Var_SysBase;
- /* **********************************************************************
- */
- /* TEST OF COEFFICIENT NUMBERS */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* TEST OF COEFFICIENT NUMBERS */
+ /* ***********************************************************************/
if (*ncofmx < *ncoefu)
{
goto L9999;
}
- /* **********************************************************************
- */
- /* CASE WHEN UPARA1=VPARA1=0 AND UPARA2=VPARA2=1 */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* CASE WHEN UPARA1=VPARA1=0 AND UPARA2=VPARA2=1 */
+ /* ***********************************************************************/
if (*upara1 == 0. && *upara2 == 1. && *vpara1 == 0. && *vpara2 == 1.)
{
goto L9999;
}
- /* **********************************************************************
- */
- /* LIMITATION BY U */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* LIMITATION BY U */
+ /* ***********************************************************************/
if (*upara1 == 0. && *upara2 == 1.)
{
/* L100: */
}
- /* **********************************************************************
- */
- /* LIMITATION BY V */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* LIMITATION BY V */
+ /* ***********************************************************************/
L2000:
if (*vpara1 == 0. && *vpara2 == 1.)
goto L9999;
}
- /* ----------- LIMITATION BY V (WITH COMPRESSION I.E. NCOEFU<NCOFMX) ----
- */
+ /* ----------- LIMITATION BY V (WITH COMPRESSION I.E. NCOEFU<NCOFMX) --- */
numax = *ndimen * *ncoefu;
if (*ncofmx != *ncoefu)
{
- /* ------------------------- Dynamic allocation -------------------
- ---- */
+ /* ------------------------- Dynamic allocation ---------------------- */
ksize = *ndimen * *ncoefu * *ncoefv;
anAdvApp2Var_SysBase.mcrrqst_(&c__8, &ksize, tbaux, &iofst, &ier);
if (ier > 0)
*iercod = 13;
goto L9900;
}
- /* --------------- Compression by (NDIMEN,NCOEFU,NCOEFV) ------------
- ---- */
+ /* --------------- Compression by (NDIMEN,NCOEFU,NCOEFV) ------------- */
if (*upara1 == 0. && *upara2 == 1.)
{
AdvApp2Var_MathBase::mmfmca9_(ndimen,
&patnew[patnew_offset],
&tbaux[iofst]);
}
- /* ------------------------- Limitation by v ------------------------
- ---- */
+ /* ------------------------- Limitation by v ------------------------- */
mmarc41_(&numax, &numax, ncoefv, &tbaux[iofst], vpara1, vpara2, &tbaux[iofst], iercod);
- /* --------------------- Expansion of TBAUX into PATNEW -------------
- --- */
+ /* --------------------- Expansion of TBAUX into PATNEW -------------- */
AdvApp2Var_MathBase::mmfmca8_(ndimen,
ncoefu,
ncoefv,
&patnew[patnew_offset]);
goto L9900;
- /* -------- LIMITATION BY V (WITHOUT COMPRESSION I.E. NCOEFU=NCOFMX) ---
- ---- */
+ /* ----- LIMITATION BY V (WITHOUT COMPRESSION I.E. NCOEFU=NCOFMX) ---- */
}
else
{
goto L9999;
}
- /* **********************************************************************
- */
- /* DESALLOCATION */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* DESALLOCATION */
+ /* ***********************************************************************/
L9900:
if (iofst != 0)
*iercod = 13;
}
- /* ------------------------------ The end -------------------------------
- */
+ /* ------------------------------ The end ------------------------------ */
L9999:
if (*iercod > 0)
/* Local variables */
integer i__, nboct, nd;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* INPUT ARGUMENTS : */
/* -------------------- */
/* ISENMSC : required direction of the transfer : */
- /* 1 : passage of (NDIMEN,.) ---> (.,NDIMEN) direction to AB
- */
+ /* 1 : passage of (NDIMEN,.) ---> (.,NDIMEN) direction to AB */
/* -1 : passage of (.,NDIMEN) ---> (NDIMEN,.) direction to TS,T
V*/
/* NDIMAX : format / dimension */
/* (3,NU) --> (21,3) AB ; AB (21,3) --> (3,NU) */
/* (3,NU) --> (NU,3) AB ; AB (NU,3) --> (3,NU) */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
courb1_dim1 = *ndimax;
goto L9999;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
L9119:
*iercod = 3119;
integer ilong, isize, ii, jj, ier = 0;
intptr_t iofst = 0, iipt, jjpt;
- /************************************************************************
- *******/
+ /*************************************************************************/
/* FUNCTION : */
/* ---------- */
/* ,ISIZE2,JSIZE2,IERCOD) */
/* is valuable. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
table1_dim1 = *maxsz1;
goto L9999;
-/* ------------------------------- THE END ------------------------------
- */
+/* ------------------------------- THE END ------------------------------- */
/* --> Invalid input. */
L9100:
*iercod = 1;
doublereal t, u[20], x;
integer idimf;
doublereal c1x, c2x;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* -------- */
- /* Calculate the integral of function BFUNX passed in parameter */
+ /* Calculate the integral of function BFUNX passed in parameter */
/* between limits XD and XF . */
/* The function should be calculated for any value */
/* of the variable in the given interval.. */
/* For explications refer to the book : */
/* Complements de mathematiques a l'usage des Ingenieurs de */
/* l'electrotechnique et des telecommunications. */
- /* Par Andre ANGOT - Collection technique et scientifique du CNET
- */
+ /* Par Andre ANGOT - Collection technique et scientifique du CNET */
/* page 772 .... */
- /* The degree of LEGENDRE polynoms used is passed in parameter.
- */
+ /* The degree of LEGENDRE polynoms used is passed in parameter. */
+
/* KEYWORDS : */
/* --------- */
/* INTEGRATION,LEGENDRE,GAUSS */
/* Should be declared as EXTERNAL in the call routine. */
/* SUBROUTINE BFUNX(NDIMF,X,VAL,IER) */
/* REAL *8 X,VAL */
- /* K : Parameter determining the degree of the LEGENDRE polynom that
- */
+ /* K : Parameter determining the degree of the LEGENDRE polynom that */
/* can take a value between 0 and 10. */
- /* The degree of the polynom is equal to 4 k, that is 4, 8,
- */
+ /* The degree of the polynom is equal to 4 k, that is 4, 8, */
/* 12, 16, 20, 24, 28, 32, 36 and 40. */
- /* If K is not correct, the degree is set to 40 directly.
- */
+ /* If K is not correct, the degree is set to 40 directly. */
/* XD : Lower limit of the interval of integration. */
/* XF : Upper limit of the interval of integration. */
/* SAUX1 : Auxiliary table */
/* See the explanations detailed in the listing */
/* Use of the GAUSS method (orthogonal polynoms) */
/* The symmetry of roots of these polynomes is used */
- /* Depending on K, the degree of the interpolated polynom grows.
- */
+ /* Depending on K, the degree of the interpolated polynom grows. */
/* If you wish to calculate the integral with a given precision, */
- /* loop on k varying from 1 to 10 and test the difference of 2
- */
+ /* loop on k varying from 1 to 10 and test the difference of 2 */
/* consecutive iterations. Stop the loop if this difference is less that */
/* an epsilon value set to 10E-6 for example. */
- /* If S1 and S2 are 2 successive iterations, test following this example :
- */
+ /* If S1 and S2 are 2 successive iterations, test following this example: */
/* AF=DABS(S1-S2) */
/* AS=DABS(S2) */
- /* If AS < 1 test if FS < eps otherwise test if AF/AS < eps
- */
+ /* If AS < 1 test if FS < eps otherwise test if AF/AS < eps */
/* -- ----- ----- */
/* > */
- /************************************************************************
- ******/
- /* DECLARATIONS */
- /************************************************************************
- ******/
+ /*************************************************************************/
+ /* DECLARATIONS */
+ /*************************************************************************/
/* ****** General Initialization */
c2x = (*xf - *xd) * .5;
/* ---------------------------------------- */
- /* ****** Integration for degree NDEG ** */
+ /* Integration for degree NDEG */
/* ---------------------------------------- */
i__1 = ndeg;
doublereal mat[36] /* was [6][6] */;
integer cot;
doublereal abid[72] /* was [12][6] */;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* (ABS(DEBFIN(1)+ABS(DEBFIN(2))) > 1/100 */
/* (for overflows) */
- /* ABS(DEBFIN(2)-DEBFIN(1)) / (ABS(DEBFIN(1)+ABS(DEBFIN(2))) > 1/100
- */
+ /* ABS(DEBFIN(2)-DEBFIN(1)) / (ABS(DEBFIN(1)+ABS(DEBFIN(2))) > 1/100 */
/* (for the conditioning) */
/* OUTPUT ARGUMENTS : */
/* This program initializes the coefficients of Hermit polynoms */
/* that are read later by MMHERM1 */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* HERMITE */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* The coefficients of hermit polynoms are calculated by */
/* the routine MMHERM0 and read by the routine MMHERM1 */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* NBCOEF is the size of CMHERM (see below) */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Data checking */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--debfin;
goto L9101;
}
- /* ***********************************************************************
- */
- /* Initialization */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* Initialization */
+ /* ***********************************************************************/
*iercod = 0;
epspi = 1e-10;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* IS IT ALREADY INITIALIZED ? */
goto L9001;
- /* ***********************************************************************
- */
- /* CALCULATION */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* CALCULATION */
+ /* ***********************************************************************/
L100:
for (jj = pp; jj <= i__2; ++jj)
{
- /* everything is done in these 3 lines
- */
+ /* everything is done in these 3 lines */
mat[ii + jj * 6 - 7] = cof[jj - 1] * prod;
cof[jj - 1] *= jj - pp;
/* L2010: */
}
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* The initialized flag is located: */
d1 = advapp_abs(debfin[1]) + advapp_abs(debfin[2]);
mmcmher_.verifi = d1 * 16111959;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
goto L9999;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
*iercod = -1;
goto L9999;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
L9999:
AdvApp2Var_SysBase::maermsg_("MMHERM0", iercod, 7L);
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
return 0;
} /* mmherm0_ */
doublereal d1;
integer cot;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* PMN : initialisation is no more done by the caller. */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* HERMITE */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* the coefficients of Hetmit polynoms are calculated by */
/* routine MMHERM0 and read by routine MMHERM1 */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* NBCOEF is the size of CMHERM (see lower) */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Initializations */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--debfin;
/* Function Body */
*iercod = 0;
- /* ***********************************************************************
- */
- /* Data Checking */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* Data Checking */
+ /* ***********************************************************************/
if (*ordrmx != 2)
{
}
}
- /* ***********************************************************************
- */
- /* READING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* READING */
+ /* ***********************************************************************/
nbval = 36;
&mmcmher_.cmherm[((((iordre[1] + (iordre[2] << 2)) << 1) + 1) * 3 + 1) * 6 + 156],
&hermit[hermit_offset]);
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
goto L9999;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
*iercod = 2;
goto L9999;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
L9999:
AdvApp2Var_SysBase::maermsg_("MMHERM1", iercod, 7L);
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
return 0;
} /* mmherm1_ */
integer ier;
integer aux1, aux2;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* -------------------- */
/* ORDHER : ORDER OF HERMIT POLYNOMS OR ORDER OF CONTINUITY */
/* NCOEFS : NUMBER OF COEFFICIENTS OF A POLYNOMIAL CURVE */
- /* FOR ONE OF ITS NDIM COMPONENTS;(DEGREE+1 OF THE CURVE)
- */
+ /* FOR ONE OF ITS NDIM COMPONENTS;(DEGREE+1 OF THE CURVE) */
/* NDIM : DIMENSION OF THE CURVE */
/* CBHEJA : TABLE OF COEFFICIENTS OF THE CURVE IN THE BASE */
/* HERMIT JACOBI */
/* REFERENCES CALLED : */
/* --------------------- */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* ALL, INTEGER */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALIZATION */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALIZATION */
+ /* ***********************************************************************/
/* Parameter adjustments */
--ncftab;
bornes[0] = -1.;
bornes[1] = 1.;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
if (*orcont > 2)
{
goto L9999;
- /* ***********************************************************************
- */
- /* PROCESSING OF ERRORS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING OF ERRORS */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
*iercod = 2;
goto L9999;
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
doublereal epsega = 0.;
integer ibb;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* . The line is inserted only if there is no line with all
- */
+ /* . The line is inserted only if there is no line with all */
/* elements equl to those which are planned to be insered, to epsilon. */
/* . Level of de debug = 3 */
/**/
/* DECLARATIONS , CONTROL OF INPUT ARGUMENTS , INITIALIZATION */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* --- Parameters */
goto L9999;
/* ******************************************************************** */
- /* OUTPUT ERROR , RETURN CALLING PROGRAM , MESSAGES */
+ /* OUTPUT ERROR , RETURN CALLING PROGRAM , MESSAGES */
/* ******************************************************************** */
/* --- The table is already full */
integer iptt, i__, j, ibb;
doublereal bid;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
/* Matrices of conversion */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* MATH */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Legendre common / Restricted Casteljau. */
/* CANPLG : Matrix of passage to canonic from Jacobi with calculated parities */
/* PLGCAN : Matrix of passage from Jacobi to canonic with calculated parities */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
poljac_dim1 = *ndeg / 2 + 1;
AdvApp2Var_SysBase::mgenmsg_("MMJACAN", 7L);
}
- /* ----------------- Expression of terms of even degree ----------------
- */
+ /* ----------------- Expression of terms of even degree ---------------- */
i__1 = *ndeg / 2;
for (i__ = 0; i__ <= i__1; ++i__)
/* L300: */
}
- /* --------------- Expression of terms of uneven degree ----------------
- */
+ /* --------------- Expression of terms of uneven degree ---------------- */
if (*ndeg == 0)
{
/* L400: */
}
- /* -------------------------------- The end -----------------------------
- */
+ /* -------------------------------- The end ---------------------------- */
L9999:
if (ibb >= 5)
/* Local variables */
integer ndeg, i__, nd, ii, ibb;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* *********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
/* Parameter adjustments */
doublereal som;
doublereal der1, der2;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : Length of an arc of curve on a given interval */
/* ---------- for a function the mathematic representation */
/* which of is a multidimensional polynom. */
/* The polynom is a set of polynoms the coefficients which of are ranked */
- /* in a table with 2 indices, each line relative to 1 polynom. */
- /* The polynom is defined by its coefficients ordered by increasing
- * power of the variable. */
+ /* in a table with 2 indices, each line relative to 1 polynom. */
+ /* The polynom is defined by its coefficients ordered by increasing */
+ /* power of the variable. */
/* All polynoms have the same number of coefficients (and the same degree). */
/* KEYWORDS : LENGTH, CURVE */
integer kk1 = 0, kk2 = 0, kk3 = 0;
integer khe = 0, ier = 0;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
valbas_dim1 = *ncoeff;
/* Function Body */
- /* ***********************************************************************
- */
- /* INITIALIZATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALIZATIONS */
+ /* ***********************************************************************/
*iercod = 0;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
if (*nderiv > 3)
{
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
L9102:
*iercod = 2;
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
integer ncof2;
integer isize, nd, kcf, ncf;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* KEYWORDS : */
/* ----------- */
- /* TOUS , MATH_ACCES :: COURBE&,PARAMETRE& , POSITIONNEMENT , &POINT
- */
+ /* TOUS , MATH_ACCES :: COURBE&,PARAMETRE& , POSITIONNEMENT , &POINT */
/* INPUT ARGUMENTS : */
/* ------------------ */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
courbe_dim1 = *ndimax;
integer i__, nd;
doublereal fu;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--tabval;
integer ii, jj, kk1, kk2;
doublereal aux1, aux2;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
/* static variables */
/* Function Body */
- /* ***********************************************************************
- */
- /* INITIALISATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATIONS */
+ /* ***********************************************************************/
*iercod = 0;
- /* ***********************************************************************
- */
- /* Processing */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* Processing */
+ /* ***********************************************************************/
if (*nderiv > 3)
{
goto L9999;
- /* ***********************************************************************
- */
- /* PROCESSING OF ERRORS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING OF ERRORS */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
goto L9999;
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
integer imin, jmin, i__, j, k;
logical trouve;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALIZATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALIZATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
aposit -= 3;
}
*iercod = 0;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
i__1 = *dimmat;
for (i__ = 1; i__ <= i__1; ++i__)
}
}
- goto L9999;
-
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
-
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ goto L9999;
+
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
+
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
integer ier;
integer aux;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* -------------------- */
/* HDIMEN: NUMBER OF LINE (OR COLUMN) OF THE HESSIAN MATRIX */
/* GDIMEN: NUMBER OF LINE OF THE MATRIX OF CONSTRAINTS */
- /* HNSTOC: NUMBERS OF TERMS IN THE PROFILE OF HESSIAN MATRIX
- */
+ /* HNSTOC: NUMBERS OF TERMS IN THE PROFILE OF HESSIAN MATRIX */
/* GNSTOC: NUMBERS OF TERMS IN THE PROFILE OF THE MATRIX OF CONSTRAINTS */
/* MNSTOC: NUMBERS OF TERMS IN THE PROFILE OF THE MATRIX M= G H t(G) */
/* where H IS THE HESSIAN MATRIX AND G IS THE MATRIX OF CONSTRAINTS */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALISATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
--vecsol;
iofmam = 0;
iofmch = 0;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
/* Dynamic allocation */
AdvApp2Var_SysBase anAdvApp2Var_SysBase;
goto L9999;
- /* ***********************************************************************
- */
- /* PROCESSING OF ERRORS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING OF ERRORS */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
AdvApp2Var_SysBase::mswrdbg_("MMRESOL : PROBLEM WITH DIMMAT", 30L);
*iercod = 2;
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
doublereal somme;
integer pointe, ptcour;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FuNCTION : */
/* ---------- T */
/* LEVEL OF DEBUG = 4 */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALISATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
--posuiv;
}
*iercod = 0;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
/* ----- Solution of Sw = b */
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* RETURN PROGRAM CALLING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN PROGRAM CALLING */
+ /* ***********************************************************************/
L9999:
integer ii, jj, kk;
doublereal akj;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* To use this routine, it is recommended to use one of */
/* interfaces : MMRSLWI or MMMRSLWD. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
/* Function Body */
*iercod = 0;
- /* *********************************************************************
- */
- /* Triangulation of matrix ABMATR. */
- /* *********************************************************************
- */
+ /* ***********************************************************************/
+ /* Triangulation of matrix ABMATR. */
+ /* ***********************************************************************/
i__1 = *nordre;
for (kk = 1; kk <= i__1; ++kk)
{
- /* ---------- Find max pivot in column KK. ------------
- --- */
+ /* ---------- Find max pivot in column KK. --------------- */
pivot = *epspiv;
kpiv = 0;
goto L9900;
}
- /* --------- Swapping of line KPIV with line KK. ------
- --- */
+ /* --------- Swapping of line KPIV with line KK. --------- */
if (kpiv != kk)
{
}
}
- /* ---------- Removal and triangularization. -----------
- --- */
+ /* ---------- Removal and triangularization. -------------- */
pivot = -abmatr[kk + kk * abmatr_dim1];
i__2 = *nordre;
/* L1000: */
}
- /* *********************************************************************
- */
- /* Solution of the system of triangular equations. */
- /* Matrix ABMATR(NORDRE+JJ,II), contains second members */
- /* of the system for 1<=j<=NDIMEN and 1<=i<=NORDRE. */
- /* *********************************************************************
- */
+ /* ***********************************************************************/
+ /* Solution of the system of triangular equations. */
+ /* Matrix ABMATR(NORDRE+JJ,II), contains second members */
+ /* of the system for 1<=j<=NDIMEN and 1<=i<=NORDRE. */
+ /* ***********************************************************************/
- /* ---------------- Calculation of solutions by ascending. -----------------
- */
+ /* ---------------- Calculation of solutions by ascending. ------------- */
for (kk = *nordre; kk >= 1; --kk)
{
goto L9999;
/* ------If the absolute value of a pivot is smaller than -------- */
- /* ---------- EPSPIV: return the code of error. ------------
- */
+ /* ---------- EPSPIV: return the code of error. ------------ */
L9900:
*iercod = 1;
/* IMPLICIT DOUBLE PRECISION (A-H,O-Z) */
/* IMPLICIT INTEGER (I-N) */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* is the index of columns (Compare with MMRSLWI which is faster). */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
{
integer ideb, nmod2, nsur2, ilong, ibb;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* tested. The caller should make the test. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* Name of the routine */
/* Common MLGDRTL: */
/* AND the weight of Gauss quadrature formulas on all */
/* POSITIVE roots of Legendre polynoms. */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* BASE LEGENDRE */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ROOTAB : Table of all rotts of Legendre polynoms */
/* between [0,1]. They are ranked for degrees increasing from 2 to 61. */
/* RTLTB1 : Table of Li(uk) where uk are roots of a */
/* Legendre polynom of UNEVEN degree. */
- /************************************************************************
- *****/
+ /*************************************************************************/
/* Parameter adjustments */
--rtlegd;
ideb = nsur2 * (nsur2 - 1) / 2 + 1;
AdvApp2Var_SysBase::mcrfill_(&ilong, &mlgdrtl_.rootab[ideb + nmod2 * 465 - 1], &rtlegd[1]);
- /* ----------------------------- The end --------------------------------
- */
+ /* ----------------------------- The end ------------------------------- */
L9999:
if (ibb >= 3)
/* Local variables */
integer ideb, ifin, imil, ibb;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* -------- */
/* One searches the interval containing TPARAM by */
/* dichotomy. Complexity of the algorithm : Log(n)/Log(2).(RBD). */
/* > */
- /* ***********************************************************************
- */
+ /* ************************************************************************/
/* Initialisations */
goto L9999;
}
- /* ----------------------- SEARCH OF THE INTERVAL --------------------
- */
+ /* ----------------------- SEARCH OF THE INTERVAL -------------------- */
L1000:
goto L1000;
/* -------------- TEST IF TPARAM IS NOT A VALUE --------- */
- /* ------------------------OF TABLEV UP TO EPSIL ----------------------
- */
+ /* ------------------------OF TABLEV UP TO EPSIL ---------------------- */
L2000:
if ((d__1 = *tparam - tablev[ideb], advapp_abs(d__1)) < *epsil)
goto L9999;
}
- /* --------------------------- THE END ----------------------------------
- */
+ /* --------------------------- THE END --------------------------------- */
L9999:
if (*iercod > 0)
doublereal somme;
integer aux;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALISATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
--vecin;
}
*iercod = 0;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
i__1 = *ncolon;
for (i__ = 1; i__ <= i__1; ++i__)
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
doublereal bidon, error;
integer nd;
- /* ***********************************************************************
- */
+ /* ************************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ------- Minimum degree that can be attained : Stop at 1 (RBD) ---------
- */
+ /* ------- Minimum degree that can be attained : Stop at 1 (RBD) ------- */
/* Parameter adjustments */
--ycvmax;
/* Function Body */
*ncfnew = 1;
- /* ------------------- Init for error calculation -----------------------
- */
+ /* ------------------- Init for error calculation ---------------------- */
i__1 = *ndimen;
for (i__ = 1; i__ <= i__1; ++i__)
{
/* Cutting of coefficients. */
ncut = 2;
- /* ------ Loop on the series of Legendre :NCOEFF --> 2 (RBD) -----------
- */
+ /* ------ Loop on the series of Legendre :NCOEFF --> 2 (RBD) ----------- */
i__1 = ncut;
for (i__ = *ncoeff; i__ >= i__1; --i__)
{
/* L300: */
}
- /* --------------------------------- End --------------------------------
- */
+ /* --------------------------------- End ------------------------------- */
L9999:
return 0;
integer ia, nd;
doublereal bid, eps1;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
- /* YCVMAX : Auxiliary table (error max on each dimension).
- */
+ /* YCVMAX : Auxiliary table (error max on each dimension). */
/* EPSTRC : Precision of the approximation. */
/* NCFNEW : Degree +1 of the resulting polynom. */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--ycvmax;
/* Function Body */
- /* Minimum degree that can be reached : Stop at IA (RBD). -------------
- */
+ /* Minimum degree that can be reached : Stop at IA (RBD). ------------ */
ia = 2;
*ncfnew = ia;
/* Init for calculation of error. */
/* Cutting of coefficients. */
ncut = ia + 1;
- /* ------ Loop on the series of Jacobi :NCOEFF --> IA+1 (RBD) ----------
- */
+ /* ------ Loop on the series of Jacobi :NCOEFF --> IA+1 (RBD) ---------- */
i__1 = ncut;
for (i__ = *ncoeff; i__ >= i__1; --i__)
{
/* L300: */
}
- /* ------- Cutting of zero coeffs of interpolation (RBD) -------
- */
+ /* ------- Cutting of zero coeffs of interpolation (RBD) ------- */
L400:
if (*ncfnew == ia)
*ncfnew = 1;
}
- /* --------------------------------- End --------------------------------
- */
+ /* --------------------------------- End ------------------------------- */
L9999:
return 0;
integer ia, nd;
doublereal bid, eps1;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
- /* Lowers the degree of a curve defined on (-1,1) in the direction of */
- /* Legendre with a given precision. */
+ /* Lowers the degree of a curve defined on (-1,1) in the direction */
+ /* of Legendre with a given precision. */
/* KEYWORDS : */
/* ----------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--ycvmax;
/* Function Body */
- /* Minimum degree that can be reached : Stop at IA (RBD). -------------
- */
+ /* Minimum degree that can be reached : Stop at IA (RBD). ------------ */
ia = 4;
*ncfnew = ia;
/* Init for error calculation. */
/* Cutting of coefficients. */
ncut = ia + 1;
- /* ------ Loop on the series of Jacobi :NCOEFF --> IA+1 (RBD) ----------
- */
+ /* ------ Loop on the series of Jacobi :NCOEFF --> IA+1 (RBD) ---------- */
i__1 = ncut;
for (i__ = *ncoeff; i__ >= i__1; --i__)
{
/* L300: */
}
- /* ------- Cutting of zero coeffs of the pole of interpolation (RBD) -------
- */
+ /* ------- Cutting of zero coeffs of the pole of interpolation (RBD) --- */
L400:
if (*ncfnew == ia)
*ncfnew = 1;
}
- /* --------------------------------- End --------------------------------
- */
+ /* --------------------------------- End ------------------------------- */
L9999:
return 0;
integer ia, nd;
doublereal bid, eps1;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
- /* Lowers the degree of a curve defined on (-1,1) in the direction of */
- /* Legendre to a given precision. */
+ /* Lowers the degree of a curve defined on (-1,1) in the direction */
+ /* of Legendre to a given precision. */
/* KEYWORDS : */
/* ----------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--ycvmax;
/* Function Body */
- /* Minimum degree that can be reached : Stop at IA (RBD). -------------
- */
+ /* Minimum degree that can be reached : Stop at IA (RBD). ------------ */
ia = 6;
*ncfnew = ia;
/* Init for error calculation. */
/* Cutting of coefficients. */
ncut = ia + 1;
- /* ------ Loop on the series of Jacobi :NCOEFF --> IA+1 (RBD) ----------
- */
+ /* ------ Loop on the series of Jacobi :NCOEFF --> IA+1 (RBD) ---------- */
i__1 = ncut;
for (i__ = *ncoeff; i__ >= i__1; --i__)
{
/* L300: */
}
- /* ------- Cutting of zero coeff. of the pole of interpolation (RBD) -------
- */
+ /* ------- Cutting of zero coeff. of the pole of interpolation (RBD) --- */
L400:
if (*ncfnew == ia)
*ncfnew = 1;
}
- /* --------------------------------- End --------------------------------
- */
+ /* --------------------------------- End ------------------------------- */
L9999:
return 0;
/* Local variables */
integer ia;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
- /* Lower the degree of a curve defined on (-1,1) in the direction of */
- /* Legendre with a given precision. */
+ /* Lower the degree of a curve defined on (-1,1) in the direction */
+ /* of Legendre with a given precision. */
/* KEYWORDS : */
/* ----------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--ycvmax;
mmtrpj6_(ncofmx, ndimen, ncoeff, epsi3d, &crvlgd[crvlgd_offset], &ycvmax[1], errmax, ncfnew);
}
- /* ------------------------ End -----------------------------------------
- */
+ /* ------------------------ End ----------------------------------------- */
return 0;
} /* mmtrpjj_ */
doublereal bid;
doublereal eps0;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* NDIMEN : DIMENSION OF THE SPACE */
/* VECTOR : VECTOR TO BE NORMED */
/* EPSILN : EPSILON BELOW WHICH IT IS CONSIDERED THAT THE */
- /* NORM OF THE VECTOR IS NULL. IF EPSILN<=0, A DEFAULT VALUE */
- /* IS IMPOSED (10.D-17 ON VAX). */
+ /* NORM OF THE VECTOR IS NULL. IF EPSILN<=0, A DEFAULT */
+ /* VALUE IS IMPOSED (10.D-17 ON VAX). */
/* OUTPUT ARGUMENTS : */
/* ------------------- */
/* vector except for one cost 0 with machine precision. In */
/* this case the quasi-null components are set to 0.D0. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--vecnrm;
/* Function Body */
*iercod = 0;
- /* -------- Precision by default : zero machine 10.D-17 on Vax ------
- */
+ /* -------- Precision by default : zero machine 10.D-17 on Vax --------- */
AdvApp2Var_SysBase::maovsr8_(&nchif);
if (*epsiln <= 0.)
eps0 = *epsiln;
}
- /* ------------------------- Calculation of the norm --------------------
- */
+ /* ------------------------- Calculation of the norm ------------------- */
vnorm = AdvApp2Var_MathBase::mzsnorm_(ndimen, &vector[1]);
if (vnorm <= eps0)
goto L9999;
}
- /* ---------------------- Calculation of the vector norm ---------------
- */
+ /* ---------------------- Calculation of the vector norm -------------- */
izero = 0;
i__1 = (-nchif - 1) / 2;
/* L20: */
}
- /* ------ Case when all coordinates except for one are almost null ----
- */
- /* ------------- then one of coordinates costs 1.D0 or -1.D0 --------
- */
+ /* ------ Case when all coordinates except for one are almost null ----- */
+ /* ------------- then one of coordinates costs 1.D0 or -1.D0 ----------- */
if (izero == *ndimen - 1)
{
}
}
- /* -------------------------------- The end -----------------------------
- */
+ /* -------------------------------- The end ---------------------------- */
L9999:
return 0;
integer ibb;
- /************************************************************************
- *******/
+ /*************************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* MITERR ... NITERR */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* NITERM : MAX NB OF ITERATIONS */
/* NITERR : NB OF RAPID ITERATIONS */
/* EPS3 : TOLERANCE TO AVOID DIVISION BY 0.. */
/* EPS4 : TOLERANCE ANGULAR */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
ibb = AdvApp2Var_SysBase::mnfndeb_();
if (ibb >= 5)
doublereal valaux;
integer aux;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALISATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALISATIONS */
+ /* ***********************************************************************/
/* Parameter adjustments */
--vecout;
}
*iercod = 0;
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
if (*ndimen <= 1 || *ndimen > 3)
{
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
L9101:
*iercod = 1;
goto L9999;
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
{
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* INITIALIZATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INITIALIZATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* MITERR ... NITERR */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* NITERM : MAX NB OF ITERATIONS */
/* NITERR : NB OF RAPID ITERATIONS */
/* EPS3 : TOLERANCE TO AVOID DIVISION BY 0.. */
/* EPS4 : TOLERANCE ANGULAR */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
mmprcsn_.eps1 = *epsil1;
mmprcsn_.eps2 = *epsil2;
mmprcsn_.eps3 = *epsil3;
return result;
}
-/* **********************************************************************
- */
+/* *************************************************************************/
/* FUNCTION : */
/* ---------- */
-/* Calculate integer function power not obligatory in the most efficient way ;
- */
+/* Calculate integer function power not obligatory in the most */
+/* efficient way */
/* KEYWORDS : */
/* ----------- */
return result;
}
-/* **********************************************************************
- */
-/* **********************************************************************
- */
+/* *************************************************************************/
+
+/* *************************************************************************/
/* FUNCTION : */
/* ---------- */
-/* Calculate integer function power not obligatory in the most efficient way ;
- */
+/* Calculate integer function power not obligatory in the most */
+/* efficient way */
/* KEYWORDS : */
/* ----------- */
integer i__;
doublereal x;
- /************************************************************************
- *******/
+ /*************************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* PRODUIT MSCALAIRE */
/* Parameter adjustments */
}
ret_val = x;
- /* ----------------------------------- THE END --------------------------
- */
+ /* ----------------------------------- THE END ------------------------- */
return ret_val;
} /* msc_ */
doublereal bid;
doublereal cij1, cij2;
- /************************************************************************
- *******/
+ /*************************************************************************/
/* FONCTION : */
/* ---------- */
/* NDGCNP+1 = 61. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* Coeff of binome from 0 to 60. read only . init par block data */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* The coefficients of the binome form a triangular matrix. */
/* This matrix is completed in table CNP by transposition. */
/* created by program MQINICNP.FOR (see the team (AC) ). */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
crvnew -= 3;
// extern /* Subroutine */ int maermsg_();
doublereal cij1, cij2, cij3;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* THE NUMBER OF COEFF OF THE CURVE IS LIMITED TO NDGCNP+1 = 61 */
/* BECAUSE OF USE OF COMMON MCCNP. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* Binomial Coeff from 0 to 60. read only . init par block data */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* The binomial coefficients form a triangular matrix. */
/* This matrix is completed in table CNP by its transposition. */
/* Initialisation is done by block-data MMLLL09.RES, */
/* created by program MQINICNP.FOR (see the team (AC) ). */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
crvnew -= 4;
NCollection_Array1<doublereal> tamp(tampc[0], 1, 40);
integer ndegl = 0, kg = 0, ii = 0;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* -------- */
/* See detailed explications on the listing */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* ------------------------------------ */
- /* ****** Test validity of KINDIC ** */
+ /* ****** Test validity of KINDIC ***** */
/* ------------------------------------ */
/* Parameter adjustments */
*nbrval = kg << 1;
ndegl = *nbrval << 1;
- /* ----------------------------------------------------------------------
- */
- /* ****** Load NBRVAL positive roots depending on the degree **
- */
- /* ----------------------------------------------------------------------
- */
+ /* --------------------------------------------------------------------- */
+ /* ****** Load NBRVAL positive roots depending on the degree *********** */
+ /* --------------------------------------------------------------------- */
/* ATTENTION : Sign minus (-) in the loop is intentional. */
mmextrl_(&ndegl, tamp);
}
/* ------------------------------------------------------------------- */
- /* ****** Loading of NBRVAL Gauss weight depending on the degree ** */
+ /* ****** Loading of NBRVAL Gauss weight depending on the degree ***** */
/* ------------------------------------------------------------------- */
mmexthi_(&ndegl, tamp);
}
/* ------------------------------- */
- /* ****** End of sub-program ** */
+ /* ****** End of sub-program ***** */
/* ------------------------------- */
return 0;
integer ndeg, kk;
doublereal xxx, yyy;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* MSCHEMA OF HORNER. */
/* > */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
- /* -------- INITIALIZATIONS AND PROCESSING OF PARTICULAR CASES ----------
- */
+ /* -------- INITIALIZATIONS AND PROCESSING OF PARTICULAR CASES --------- */
/* ---> Cas when NCOEFF > 1 (case STANDARD). */
/* Parameter adjustments */
goto L9999;
}
- /* -------------------- MSCHEMA OF HORNER (PARTICULAR CASE) --------------
- */
+ /* -------------------- MSCHEMA OF HORNER (PARTICULAR CASE) ------------ */
L1000:
goto L9999;
}
- /* ---------------------------- MSCHEMA OF HORNER ------------------------
- */
+ /* ---------------------------- MSCHEMA OF HORNER ---------------------- */
/* ---> TPARAM is different from 1.D0 and 0.D0. */
ndeg = *ncoeff - 1;
}
goto L5000;
- /* ------------------------ RECOVER THE CALCULATED POINT ---------------
- */
+ /* ------------------------ RECOVER THE CALCULATED POINT --------------- */
L5000:
pntcrb[1] = xxx;
pntcrb[2] = yyy;
- /* ------------------------------ THE END -------------------------------
- */
+ /* ------------------------------ THE END ------------------------------ */
L9999:
return 0;
integer ndeg, kk;
doublereal xxx, yyy, zzz;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* MSCHEMA OF HORNER. */
/* > */
- /* **********************************************************************
- */
- /* DECLARATIONS */
- /* **********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* -------- INITIALISATIONS AND PROCESSING OF PARTICULAR CASES ----------
- */
+ /* -------- INITIALISATIONS AND PROCESSING OF PARTICULAR CASES --------- */
/* ---> Case when NCOEFF > 1 (cas STANDARD). */
/* Parameter adjustments */
goto L9999;
}
- /* -------------------- MSCHEMA OF HORNER (PARTICULAR CASE) --------------
- */
+ /* -------------------- MSCHEMA OF HORNER (PARTICULAR CASE) ------------ */
L1000:
goto L9999;
}
- /* ---------------------------- MSCHEMA OF HORNER ------------------------
- */
+ /* ---------------------------- MSCHEMA OF HORNER ---------------------- */
/* ---> Here TPARAM is different from 1.D0 and 0.D0. */
ndeg = *ncoeff - 1;
}
goto L5000;
- /* ------------------------ RETURN THE CALCULATED POINT ------------------
- */
+ /* ------------------------ RETURN THE CALCULATED POINT ---------------- */
L5000:
pntcrb[1] = xxx;
pntcrb[2] = yyy;
pntcrb[3] = zzz;
- /* ------------------------------ THE END -------------------------------
- */
+ /* ------------------------------ THE END ------------------------------ */
L9999:
return 0;
doublereal dsave;
integer i3, i4, i5, incrp1;
- /************************************************************************
- *******/
+ /*************************************************************************/
/* FUNCTION : */
/* ---------- */
/* CLASSIC SHELL METHOD : PARSING BY SERIES */
/* Declaration DTAB(IS, 1) corresponds to DTAB(IS, *) */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
dtab_dim1 = *is;
doublereal xsom;
integer i__, irmax;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* Z = !V(1)! * V 1 + (V(2)/V(1))**2 + ... */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
/* ___ Find the strongest absolute value term */
ret_val = (d__1 = vecteu[irmax], advapp_abs(d__1)) * sqrt(xsom);
}
- /* ***********************************************************************
- */
- /* RETURN CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN CALLING PROGRAM */
+ /* ***********************************************************************/
return ret_val;
} /* mzsnorm_ */
/* INPUT ARGUMENTS : */
/* -------------------- */
- /* IMODE : MODE of INITIALIZATION :
- 0= DEFAULT, IMP IS 6, IBB 0 and LEC 5 */
+ /* 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 */
/* NON NULL ERROR CODE INFORM IT AS WELL. */
/* (BUT IT IS NOT TRUE FOR ALL ROUTINES OF T) */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
if (*imode == 0)
{
mblank__.lec = *ival;
}
- /* ----------------------------------------------------------------------*
- */
+ /* ***********************************************************************/
return 0;
} /* macinit__ */
{
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* (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. */
+ /* If the request is lower or equal to MAXELM, IOFSET becomes = 0. */
/* Otherwise the demand of allocation is valid and IOFSET > 0. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
integer iunit;
{
integer c__8 = 8;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* Otherwise the demand of allocation is valid and IOFSET > 0. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Function Body */
if (*nbelem > *maxelm)
/* Local variables */
integer i__, j;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* FONCTION : */
+ /* FUNCTION : */
/* ---------- */
/* TABLE OF MANAGEMENT OF DYNAMIC MEMORY ALLOCATIONS */
/* ----------- */
/* SYSTEM, MEMORY, ALLOCATION */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
/* 1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
/* 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;
{
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FuNCTION : */
/* ---------- */
/* ----------------------------------- */
/* (Cf description in the heading of MCRDELT) */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
integer iunit;
iunit = sizeof(integer);
{
integer c__8 = 8;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* (Cf description in the heading of MCRDELT) */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Function Body */
if (*iofset != 0)
/* Fortran I/O blocks */
// cilist io___1 = { 0, 6, 0, "(X,A,I9,A,I3)", 0 };
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* 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));
integer ibid, ienr;
integer novfl = 0;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* SYSTEM, MEMORY, ALLOCATION */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
/* 1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
/* (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
/* LPROT : COMMUNICATION BETWEEN CRPROT AND MCRRQST, SET TO 0 BY MCRRQST */
/* FLAG : VALUE OF THE FLAG USED FOR EXCESSES */
- /* ----------------------------------------------------------------------*
- */
+ /* --------------------------------------------------------------------- */
if (ifois == 0)
{
integer inum;
char /*cfm[80],*/ cln[3];
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* INPUT ARGUMENTSEE : */
/* ------------------- */
- /* CROUT : NAME OF THE CALLING ROUTINE : MCRRQST, MCRDELT, MCRLIST
- */
+ /* CROUT : NAME OF THE CALLING ROUTINE : MCRRQST, MCRDELT, MCRLIST */
/* ,CRINCR OR CRPROT */
/* NUM : MESSAGE NUMBER */
/* IT : TABLE OF INTEGER DATA */
/* 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 */
}
}
*/
- /* ----------------------------------------------------------------------*
- */
- /* iMPLEMENTATION OF WRITE , WITH OR WITHOUT DATA : */
+ /* --------------------------------------------------------------------- */
+ /* IMPLEMENTATION OF WRITE , WITH OR WITHOUT DATA : */
if (inum == 0)
{
char cbid[255];
integer ibid, ier;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* SPECIFIC SGI ROUTINE */
- /* IN ALL CASES WHEN IERCOD IS >0, NO RESULT IS RETURNED*/
+ /* IN ALL CASES WHEN IERCOD IS >0, NO RESULT IS RETURNED */
/* NOTION OF "USER SYNTAX' AND "INTERNAL SYNTAX" */
/* --------------------------------------------------- */
/* (OPEN,INQUIRE,...ETC) */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
*long__ = 0;
*iercod = 0;
goto L9999;
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
L9500:
*iercod = 5;
*iercod = 7;
//__s__copy(chaine, " ", chaine_len, 1L);
- /* ***********************************************************************
- */
- /* RETURN TO THE CALLING PROGRAM */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* RETURN TO THE CALLING PROGRAM */
+ /* ***********************************************************************/
L9999:
return 0;
doublereal buffx[63];
integer nbfois, noffst, nreste, nufois;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ACCESS : FREE */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Parameter adjustments */
--xtab;
/* Function Body */
- /* ----------------------------------------------------------------------*
- */
+ /* --------------------------------------------------------------------- */
nbfois = *itaill / 63;
noffst = nbfois * 63;
}
}
- /* ----------------------------------------------------------------------*
- */
+ /* --------------------------------------------------------------------- */
return 0;
} /* maitbr8_ */
{
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* SO IT IS ENOUGH TO PROVIDE THAT THIS INIT IS */
/* CORRECTLY IMPLEMENTED IN THE RESPECTIVE PROGRAMS */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* INCLUDE MACETAT */
/* < */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* APPLICATION, LANGUAGE */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* A) CHLANG*4 : LIST OF POSSIBLE VALUES OF THE LANGUAGE : */
/* ---------------------------------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* NUMBER OF APPLICATIONS TAKEN INTO ACCOUNT */
{
integer imod;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* - EXISTENCE OF FILE 'STRMINIT:STRMTRBK.DAT' */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
madbtbk_(&imod);
if (imod == 1)
{
doublereal buff[63];
integer ioct, indic, nrest, icompt;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* 2) Doc. designer : */
- /* The idea is to minimize the number of calls */
+ /* 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 */
/* * 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
*/
/* !__________! */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* Inclusion of MAOVPAR.INC */
/* CONSTANTS */
/* INCLUDE MAOVPAR */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* SYSTEM, LIMITS, VALUES, SPECIFIC */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* *** THEY CAN'T BE REMOVED DURING EXECUTION. */
/* THEY ARE DEFINED AS HEXADECIMAL VALUES */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* DECLARATION OF THE COMMON FOR NUMERIC TYPES */
/* Function Body */
- /* vJMB R8OVR IS NOT YET initialized, so impossible to use DATA
- */
+ /* vJMB R8OVR IS NOT YET initialized, so impossible to use DATA */
/* DATA BUFF / NLONGR * R8OVR / */
/* init of BUFF is done only once */
/* Local variables */
char chainx[255] = {};
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* - IN CASE OF ERROR (IERCOD>0), CHAIN = ' ' AND LENGTH = 0 */
/* - IF THE INPUT VARIABLE CNMSYM IS EMPTY, THE ROUTINE RETURNS IERCOD=1*/
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* SGI...v */
//__s__copy(chaine, chainx, chaine_len, 255L);
/* SGI...^ */
- /* ***********************************************************************
- */
- /* ERROR PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* ERROR PROCESSING */
+ /* ***********************************************************************/
/* L9999: */
return 0;
intptr_t ipre;
integer i__, j, k;
- /************************************************************************
- *******/
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
- /* ATTENTION .... ITAB ARE NTAB NOT SAVED BETWEEN 2 CALLS..
- */
+ /* ATTENTION .... ITAB ARE NTAB NOT SAVED BETWEEN 2 CALLS.. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* JPF PARAMETER ( MAXNUM = 40 , MAXCOM = 500 * 1024 ) */
/* PP COMMON / CRGEN2 / DTAB */
- /* ----------------------------------------------------------------------*
- */
+ /* ***********************************************************************/
*ier = 0;
intptr_t iadfd, iadff, iaddr, loc; /* Les adrresses en long*/
integer kop;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* valid only if the same sub-program uses and destroys the allocation. */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* COMMON OF PARAMETERS */
/* COMMON OF STATISTICS */
/* INCLUDE MCRGENE */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ---------- */
/* SYSTEM, MEMORY, ALLOCATION */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
/* 1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
/* (PROTECTED MEANS NOT DESTROYED BY CRRSET .) */
/* 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 */
}
goto L9900;
- /* ----------------------------------------------------------------------*
- */
+ /* --------------------------------------------------------------------- */
/* ERROR PROCESSING */
L9001:
C REFERENCES CALLED :
C -------------------
C
-C DEMSCRIPTION/NOTES/LIMITATIONS :
+C DESCRIPTION/NOTES/LIMITATIONS :
C -----------------------------------
C Routine portable UNIX (SGI, ULTRIX, BULL)
C
/* */
/* FUNCTION : */
/* ---------- */
-/* Routines for management of the dynamic memory. */
+/* Routines for management of the dynamic memory. */
/* */
/* Routine mcrfree */
/* -------------- */
/*........................................................................*/
/* */
-/* FONCTION : */
+/* FUNCTION : */
/* ---------- */
/* Routines for management of the dynamic memory. */
/* */
/* = 1 ==> Allocation impossible */
/* = -1 ==> Offset > 2**31 - 1 */
/* */
-
/* */
/*........................................................................*/
integer ifmt, i__, nufmt, ntotal;
char subrou[7];
- /************************************************************************
- *******/
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* . NONE */
/* > */
- /* ***********************************************************************
- */
-
- /* INCLUDE MCRGENE */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* INCLUDE MCRGENE */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------- */
/* SYSTEM, MEMORY, ALLOCATION */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
/* 1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
/* 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);
intptr_t iadfd, iadff, iaddr, lofset, loc;
integer izu;
- /* **********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* 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"
- */
+ /* "The system refuses dynamic allocation of memory of N octets" */
/* with completev display of all allocations carried out till now */
/* 2) DESIGNER */
/* 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 */
/* ----------- */
/* SYSTEM, MEMORY, ALLOCATION */
- /* DEMSCRIPTION/NOTES/LIMITATIONS : */
+ /* DESCRIPTION/NOTES/LIMITATIONS : */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ICORE : TABLE OF EXISTING ALLOCATIONS, EACH HAVING : */
/* 1 : LEVEL OF PROTECTION (0=NOT PROTECTED, OTHER=PROTECTED) */
/* 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 */
/* NBYTE : TOTAL NUMBER OF OCTETS OF ALLOCATIONS */
/* MBYTE : MAX NUMBER OF OCTETS */
- /* ----------------------------------------------------------------------*
- */
+ /* --------------------------------------------------------------------- */
/* Function Body */
*iercod = 0;
mcrlist_(&ier);
goto L9900;
- /* ----------------------------------------------------------------------*
- */
+ /* --------------------------------------------------------------------- */
L9900:
mcrgene_.lprot = 0;
C REFERENCES CALLED :
C ---------------------
C
-C DEMSCRIPTION/NOTES/LIMITATIONS :
+C DESCRIPTION/NOTES/LIMITATIONS :
C -----------------------------------
C
C Portable VAX-SGI
{
integer nocte;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ___ NOCTE : Number of octets to transfer */
{
integer nocte;
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
- /* FONCTION : */
+ /* FUNCTION : */
/* ---------- */
/* Transfer real from one zone to another */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* ___ NOCTE : Nb of octets to transfer */
{
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
/* FUNCTION : */
/* ---------- */
/* ----------------------------------- */
/* > */
- /* ***********************************************************************
- */
- /* DECLARATIONS */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* DECLARATIONS */
+ /* ***********************************************************************/
- /* ***********************************************************************
- */
- /* PROCESSING */
- /* ***********************************************************************
- */
+ /* ***********************************************************************/
+ /* PROCESSING */
+ /* ***********************************************************************/
if (AdvApp2Var_SysBase::mnfndeb_() >= 1)
{
C REFERENCES CALLED :
C -----------------------
C
-C DEMSCRIPTION/NOTES/LIMITATIONS :
+C DESCRIPTION/NOTES/LIMITATIONS :
C -----------------------------------
C
C
projects / occt.git / commitdiff