/* MLICUP.f -- translated by f2c (version 19960827).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "Data_f2c.h"

/* Subroutine */ int mmlicup_(nmxint, nbint1, ncflim, ncftab, nbrpnt, tabpar, 
	tabint, nbint2, iercod)
integer *nmxint, *nbint1, *ncflim, *ncftab, *nbrpnt;
doublereal *tabpar, *tabint;
integer *nbint2, *iercod;
{
    static logical ldbg;
    static doublereal tpar;
    static integer ityp;
    static doublereal epsil;
    static integer n1, numint;
    extern /* Subroutine */ int mmsrre2_();
    static integer ier;
    extern integer mnfndeb_();
    static integer ipt;
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mvsheld_(), mgsomsg_()
	    ;
    static integer ipt1, ipt2;



/* < */
/* **NOTICE */
/*  THIS SOFTWARE IS THE PROPERTY OF CISIGRAPH. */
/*  THIS CODE MUST NOT BE DISTRIBUTED OR COPIED WITHOUT THE PRIOR */
/*  WRITTEN PERMISSION OF CISIGRAPH AND IS ONLY TO BE USED ON THE */
/*  SITE WHERE IT IS INSTALLED BY CISIGRAPH */
/* **NOTICE */

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

/*     FONCTION : */
/*     --------- */
/*       Realise la decoupe dans le lissage variationnel des courbes */

/*     MOTS CLES : */
/*     ----------- */
/*       RESERVE, LISSAGE, DECOUPE, NOEUDS */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*     NMXINT : Nombre maximum d'intervalle (de courbes) */
/*     NBINT1 : Nombre initial d'intervalle */
/*     NCFLIM : Nombre maximum de coeff par courbe */
/*     NCFTAB : Table donnant le nombre de cooeff pour chaquecourbe */
/*     NBRPNT: Nombre de points */
/*     TABPAR : Les parametres associes aux points */
/*     TABINT : Table noeuds avant decoupe */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*     TABINT : Table des noeuds apres decoupe */
/*     NBINT2 : Nombre d'intervalle apres decoupe */
/*     IERCOD : Coded'erreur */


/*     COMMONS UTILISES : */
/*     ------------------ */


/*     REFERENCES APPELEES : */
/*     --------------------- */


/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     27-11-1995: PMN; Ameliore le calcul de IPT1 et IPT2 */
/*      6-10-1995: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */



/* ***********************************************************************
 */
/*                      INITIALISATIONS */
/* ***********************************************************************
 */

    /* Parameter adjustments */
    --ncftab;
    --tabpar;

    /* Function Body */
    ldbg = mnfndeb_() >= 3;
    if (ldbg) {
	mgenmsg_("MMLICUP", 7L);
    }
    *iercod = 0;

/* ***********************************************************************
 */
/*                     TRAITEMENT */
/* ***********************************************************************
 */

    if (*nbint1 > *nmxint) {
	goto L9101;
    }

    numint = 0;
    *nbint2 = *nbint1;
    epsil = 1e-12;

/*    --- Subdivision des courbes de degre max */

    while(*nbint2 < *nmxint && numint < *nbint1) {

	++numint;

	if (ncftab[numint] == *ncflim) {

	    ++(*nbint2);

	    mmsrre2_(&tabint[numint - 1], nbrpnt, &tabpar[1], &epsil, &ipt1, &
		    ityp, &ier);
	    if (ityp == 2) {
		++ipt1;
	    }
	    if (ier == 1) {
		goto L9101;
	    }
	    if (ier == 2) {
		ipt1 = 1;
	    }

	    mmsrre2_(&tabint[numint], nbrpnt, &tabpar[1], &epsil, &ipt2, &
		    ityp, &ier);
	    if (ityp == 2) {
		++ipt2;
	    }
	    if (ier == 1) {
		goto L9101;
	    }
	    if (ier == 2) {
		ipt2 = *nbrpnt;
	    }

	    if (ipt2 - ipt1 >= 1) {

		ipt = (ipt1 + ipt2) / 2;
		if (ipt << 1 == ipt1 + ipt2) {
		    tpar = tabpar[ipt] * 2;
		} else {
		    tpar = tabpar[ipt] + tabpar[ipt + 1];
		}

		tabint[*nbint2] = (tabint[numint - 1] + tabint[numint] + tpar)
			 / 4;
	    } else {
		tabint[*nbint2] = (tabint[numint - 1] + tabint[numint]) / 2;
	    }
	}

    }

/*     --- subdivision des courbes de degre max - 1 */

    numint = 0;

    while(*nbint2 < *nmxint && numint < *nbint1) {

	++numint;

	if (ncftab[numint] == *ncflim - 1) {

	    ++(*nbint2);

	    mmsrre2_(&tabint[numint - 1], nbrpnt, &tabpar[1], &epsil, &ipt1, &
		    ityp, &ier);
	    if (ityp == 2) {
		++ipt1;
	    }
	    if (ier == 1) {
		goto L9101;
	    }
	    if (ier == 2) {
		ipt1 = 1;
	    }

	    mmsrre2_(&tabint[numint], nbrpnt, &tabpar[1], &epsil, &ipt2, &
		    ityp, &ier);
	    if (ityp == 2) {
		++ipt2;
	    }
	    if (ier == 1) {
		goto L9101;
	    }
	    if (ier == 2) {
		ipt2 = *nbrpnt;
	    }

	    if (ipt2 - ipt1 >= 1) {

		ipt = (ipt1 + ipt2) / 2;
		if (ipt << 1 == ipt1 + ipt2) {
		    tpar = tabpar[ipt] * 2;
		} else {
		    tpar = tabpar[ipt] + tabpar[ipt + 1];
		}

		tabint[*nbint2] = (tabint[numint - 1] + tabint[numint] + tpar)
			 / 4;
	    } else {
		tabint[*nbint2] = (tabint[numint - 1] + tabint[numint]) / 2;
	    }
	}

    }

    n1 = 1;
    mvsheld_(nbint2, &n1, &tabint[1], &n1);

    goto L9999;

/* ***********************************************************************
 */
/*                   TRAITEMENT DES ERREURS */
/* ***********************************************************************
 */

L9101:
    *iercod = 1;
    goto L9999;

/* ***********************************************************************
 */
/*                   RETOUR PROGRAMME APPELANT */
/* ***********************************************************************
 */

L9999:

    maermsg_("MMLICUP", iercod, 7L);
    if (ldbg) {
	mgsomsg_("MMLICUP", 7L);
    }
 return 0 ;
} /* mmlicup_ */

