/* MLICUT.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 mmlicut_(nbrpnt, tabpar, nbcntr, typcnt, ncofmx, nbcrmx, 
	cordre, nbrcbe, tabint, iercod)
integer *nbrpnt;
doublereal *tabpar;
integer *nbcntr, *typcnt, *ncofmx, *nbcrmx, *cordre, *nbrcbe;
doublereal *tabint;
integer *iercod;
{
    /* System generated locals */
    integer i__1, i__2;

    /* Local variables */
    static integer ideb, nbcb;
    static logical ldbg;
    static integer ndeb, ifin, nfin, ncnt, indcb, ncont, orcmx, nplus, aa, bb,
	     ii, kk, nlibre;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mgsomsg_();



/* < */
/* **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 une decoupe a priori des courbes de lissage afin */
/*       de concilier les contraintes, le degre maximum et le nombre */
/*       de courbes maximum. */

/*     MOTS CLES : */
/*     ----------- */
/*      LISSAGE, INTERPOLATION, CONTRAINTES, DECOUPE */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*     NBRPNT : Nombre de points a lisser/interpoler */
/*     TABPAR : Table des parametres associe aux points */
/*     NBCNTR : Nombre de points contraints */
/*     TYPCNT : Type des contraintes */
/*     NCOFMX : Nombre maximum de coefficient par courbe */
/*     NBCRMX : Nombre maximum de courbes */
/*     CORDRE : Ordre de continuite interne a respecter */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */
/*     NBRCBE : Nombre de courbe minimum a produire */
/*     TABINT : Tables des noeuds initiaux */
/*     IERCOD : Code d'erreur */
/*       0 : Ok */
/*       1 : Trop de contraintes pour le degre */
/*       2 : Pas assez de courbes */


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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     27-11-1995: PMN; Blindage contre les intervalles nulles */
/*     23-10-1995: PMN; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */



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

    /* Parameter adjustments */
    --tabpar;
    typcnt -= 3;

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

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


/*    (1) Calcul du nombre de courbe necessaire */

    if (*nbcntr == 0) {

/*     ---> Il n'y a pas de contraintes... */
	tabint[0] = tabpar[1];
	tabint[1] = tabpar[*nbrpnt];
	*nbrcbe = 1;
	goto L9999;
    }

    orcmx = -1;
    ncont = 0;

    i__1 = *nbcntr;
    for (ii = 1; ii <= i__1; ++ii) {
	kk = (i__2 = typcnt[(ii << 1) + 2], abs(i__2)) + 1;
	if (kk > orcmx) {
	    orcmx = kk;
	}
	ncont += kk;
    }

    if (orcmx > *ncofmx - (*cordre + 1)) {
	goto L9101;
    }

/* Computing MAX */
    i__1 = *ncofmx - (*cordre + 1) - *ncofmx / 4, i__2 = *cordre + 1;
    nlibre = max(i__1,i__2);

/*     Debut de boucle sur le nombre de contraintes max par courbe */

L1000:

    aa = ncont / nlibre;
    bb = aa * nlibre - ncont;

    if (bb == 0) {
	*nbrcbe = aa;
    } else {
	*nbrcbe = aa + 1;
    }

    if (*nbrcbe > *nbcrmx && nlibre < *ncofmx - (*cordre + 1)) {
	++nlibre;
	goto L1000;
    }

    if (*nbrcbe > *nbcrmx) {
	goto L9102;
    }


/*    (2) Decoupe de l'interval parametrique */

/*    (2.1) Nombre de contraintes par courbes */

    ncnt = (ncont - 1) / *nbrcbe + 1;
    nplus = *nbrcbe - (ncnt * *nbrcbe - ncont);

/*     (2.2) Inits */

    ideb = 0;
    ifin = *nbcntr + 1;

    ndeb = 0;
    nfin = 0;

    indcb = 0;
    nbcb = 0;

    tabint[0] = tabpar[1];
    tabint[*nbrcbe] = tabpar[*nbrpnt];

    while(*nbrcbe - nbcb > 1) {

/*        (2.3) decoupe a partir de l'origine */

	++indcb;
	++nbcb;
	if (nplus == 0) {
	    --ncnt;
	}

	while(ndeb < ncnt && ideb < ifin) {
	    ++ideb;
	    ndeb = ndeb + (i__1 = typcnt[(ideb << 1) + 2], abs(i__1)) + 1;
	}

	if (ndeb == ncnt) {
	    ndeb = 0;
	    if (nplus == 1 && tabpar[typcnt[(ideb << 1) + 1]] > tabint[indcb 
		    - 1]) {
		tabint[indcb] = tabpar[typcnt[(ideb << 1) + 1]];
	    } else {
		tabint[indcb] = (tabpar[typcnt[(ideb << 1) + 1]] + tabpar[
			typcnt[((ideb + 1) << 1) + 1]]) / 2;
	    }
	} else {
	    ndeb -= ncnt;
	    tabint[indcb] = tabpar[typcnt[(ideb << 1) + 1]];
	}

	--nplus;
	if (nplus == 0) {
	    --ncnt;
	}

	if (*nbrcbe - nbcb == 1) {
	    goto L9999;
	}

	++nbcb;

	while(nfin < ncnt && ideb < ifin) {
	    --ifin;
	    nfin = nfin + (i__1 = typcnt[(ifin << 1) + 2], abs(i__1)) + 1;
	}

	if (nfin == ncnt) {
	    nfin = 0;
	    tabint[*nbrcbe - indcb] = (tabpar[typcnt[(ifin << 1) + 1]] + 
		    tabpar[typcnt[((ifin - 1) << 1) + 1]]) / 2;
	} else {
	    nfin -= ncnt;
	    if (tabint[*nbrcbe - indcb + 1] > tabpar[typcnt[(ifin << 1) + 1]])
		     {
		tabint[*nbrcbe - indcb] = tabpar[typcnt[(ifin << 1) + 1]];
	    } else {
		tabint[*nbrcbe - indcb] = (tabpar[typcnt[(ifin << 1) + 1]] + 
			tabpar[typcnt[((ifin - 1) << 1) + 1]]) / 2;
	    }
	}

    }

    goto L9999;

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

L9101:
    *iercod = 1;
    goto L9999;

L9102:
    *iercod = 2;
    goto L9999;

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

L9999:

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

