/* MINIMI.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"

/* Table of constant values */

static integer c__400 = 400;
static integer c__100 = 100;
static integer c__50 = 50;
static integer c__4000 = 4000;

/* Subroutine */ int mminimi_(ndimen, nbrcrb, cblong, ncflim, nbrpnt, nbcntr, 
	ordher, tabpnt, tbpoid, typcnt, tabcnt, tpospt, typept, math1, math2, 
	math3, vpoids, ttheta, tfthet, tabpar, tabint, ncftab, crbtab, tvcint,
	 iercod)
integer *ndimen, *nbrcrb;
doublereal *cblong;
integer *ncflim, *nbrpnt, *nbcntr, *ordher;
doublereal *tabpnt, *tbpoid;
integer *typcnt;
doublereal *tabcnt;
integer *tpospt, *typept;
doublereal *math1, *math2, *math3, *vpoids, *ttheta, *tfthet, *tabpar, *
	tabint;
integer *ncftab;
doublereal *crbtab, *tvcint;
integer *iercod;
{
    /* System generated locals */
    integer tabpnt_dim1, tabpnt_offset, tabcnt_dim1, tabcnt_offset, 
	    ttheta_dim1, ttheta_dim2, ttheta_offset, tfthet_dim1, tfthet_dim2,
	     tfthet_offset, crbtab_dim1, crbtab_dim2, crbtab_offset, i__1;
    doublereal d__1, d__2;

    /* Local variables */
    static logical ldbg;
    static integer icrb, icnt;
    static doublereal e1bid[3], e2bid;
    static integer hdecal, dimtah, dimtag, tasemh[400], tasemg[100];
    /* Variable d'allocation en long */
    static long int iofmag, iofmah, ioftah, ioftag, iofveg, iofveh;
    static long int iofhpo, iofgpo, iofmpo, iofhps, iofmps, iofvso;
    static doublereal vecsol[100], vecsyg[100], vecsyh[100];
    static integer matsui[100];
    static doublereal matsyh[4000];
    static integer hposit[100], gposit[50], mposit[100], hposui[400];
    static doublereal matsyg[400];
    static integer dimmpo, dimhpo, dimgpo, ncfmin, hdimen, gdimen, 
           hnstoc, gnstoc, mnstoc;
    static doublereal bornes[2], epsilo;
    extern /* Subroutine */ int macrai4_(), macrar8_(), macrdi4_(), macrdr8_()
	    ;
    static integer ier;
    extern /* Subroutine */ int mmdesab_();
    extern integer mnfndeb_();
    extern /* Subroutine */ int mmhjcan_(), mmtabas_(), mmasemg_(), mmasemh_()
	    , maermsg_(), mgenmsg_(), mmvacri_(), mgsomsg_(), mmresol_(), 
	    mmcvinv_(), mmnatpt_(), mmtrpjj_(), mmtposi_(), mmposui_();



/* < */
/* **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 : */
/*     ---------- */
/*       MMINIMISATION SOUS CONTRAINTES */

/*     MOTS CLES : */
/*     ----------- */
/*      RESERVE, LISSAGE, OPTIMISATION, COURBE */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*     NDIMEN : Dimension de l'espace */

/*     NBRCRB : Nombre maxi de courbes polynomiales a calculer. */
/*    BORINF,BORSUP :Bornes inferieur et superieur du domaine de definitio
n*/
/*                    de la courbe */
/*     CBLONG : LONGUEUR ESTIMEE DE LA COURBE */
/*     NCFLIM : Nombre LIMITE de coeff des "courbes" polynomiales */
/*              d' approximation. */
/*     NBRPNT : Nombre de points a lisser  (>= 2) */
/*     NBCNTR : Nombre de point contraints (<= NBRPNT) */
/*     ORDHER : Ordre d'hermite */
/*     TABPNT : Tableau des points a lisser, TYPCNT, TABCNT,  DEBFIN, */
/*     TYPCNT(1,i) :  Indice du point contraints */
/*     TYPCNT(2,i) :  Type de la contrainte */
/*                    0 -> de passage (G0) */
/*                    1 -> de tangence (G1) */
/*                    2 -> de courbure (G2) */
/*     TABCNT(*,1,i) : Vecteur tangent a respecter */
/*     TABCNT(*,2,i) : Vecteur courbure a respecter */

/*     TPOSPT(i) : contient le numero DE L'ELEMENT DE DECOUPE */
/*                 ASSOCIE AU POINT Pi */
/*     TYPEPT(I) = 0   SI le point Pi est a lisser */
/*               = 1   Si le point Pi est contraint */
/*     MATH1,MATH2,MATH3 : Matrices des trois criteres de qualites */
/*                         pour une composante */
/*     VPOIDS : Poid respectif des criteres moindres carres  qualite */
/*        VPOIDS(1) : Poid des moindre carre */
/*        VPOIDS(2) : Poid du critere de "qualite". */
/*     TTHETA : TABLES CONTENANTS LES COORDONNEES DES VECTEURS */
/*              THETA PERMETTANT D'EXPRIMER LES CONTRAINTES DE */
/*              TANGENCE ET DE COURBURE */
/*     TFTHET : TABLES CONTENANTS LES COORDONNEES DES VECTEURS */
/*              TFHETA PERMETTANT D'EXPRIMER LES CONTRAINTES DE */
/*              DE COURBURE */
/*     TABPAR : Parametres  affecteS aux points. */

/*     TABINT : Table des NBCRBE + 1 bornes des intervalles de decoupe */
/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */

/*     NCFTAB : Nombre de coefficients de chaque courbes */
/*     CRBTAB : Tableau des coeff dans la base CANONIQUE des "courbes" */
/*              polynomiales calculees. */
/*     TVCINT : TABLE DES VALEURS DES CRITERES INTEGRALES */

/*       IERCOD : code d'erreur */
/*         0   : Ok */
/*         > 0 : Echec */

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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     15-09-95 : khn; ECRITURE VERSION ORIGINALE. */
/* > */
/* ***********************************************************************
 */
/*                            DECLARATIONS */
/* ***********************************************************************
 */















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

    /* Parameter adjustments */
    tfthet_dim1 = *ndimen;
    tfthet_dim2 = *ndimen - 1;
    tfthet_offset = tfthet_dim1 * (tfthet_dim2 + 1) + 1;
    tfthet -= tfthet_offset;
    ttheta_dim1 = *ndimen;
    ttheta_dim2 = *ndimen - 1;
    ttheta_offset = ttheta_dim1 * (ttheta_dim2 + 1) + 1;
    ttheta -= ttheta_offset;
    tabcnt_dim1 = *ndimen;
    tabcnt_offset = tabcnt_dim1 * 3 + 1;
    tabcnt -= tabcnt_offset;
    tvcint -= 4;
    --ncftab;
    crbtab_dim1 = *ndimen;
    crbtab_dim2 = *ncflim;
    crbtab_offset = crbtab_dim1 * (crbtab_dim2 + 1) + 1;
    crbtab -= crbtab_offset;
    --math3;
    --math2;
    --math1;
    --tabpar;
    --typept;
    --tpospt;
    --tbpoid;
    tabpnt_dim1 = *ndimen;
    tabpnt_offset = tabpnt_dim1 + 1;
    tabpnt -= tabpnt_offset;
    typcnt -= 3;
    --vpoids;

    /* Function Body */
    ldbg = mnfndeb_() >= 2;
    if (ldbg) {
	mgenmsg_("MIMINI ", 7L);
    }
    *iercod = 0;
    ioftah = 0;
    ioftag = 0;
    iofhpo = 0;
    iofgpo = 0;
    iofhps = 0;
    iofmps = 0;
    iofmah = 0;
    iofveh = 0;
    iofmag = 0;
    iofveg = 0;
    iofvso = 0;

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

    if (*ndimen > 3) {
	goto L9101;
    }

/*      allocations dynamiques */

    dimtah = *nbrcrb * *ncflim;
    macrai4_(&dimtah, &c__400, tasemh, &ioftah, &ier);
    if (ier > 0) {
	goto L9103;
    }
    dimtag = (*ndimen << 2) * *nbcntr;
    macrai4_(&dimtag, &c__100, tasemg, &ioftag, &ier);
    if (ier > 0) {
	goto L9103;
    }


/*        Remplissage de */
/*           TPOSPT(i) = Numero de l'element de decoupe */
/*                       correspondant au point Pi */
/*           TYPEPT(i) = 0 si le point Pi est a lisser */
/*                     = 1 si ............... contraint */
    mmnatpt_(nbrpnt, nbrcrb, nbcntr, &tabpar[1], tabint, &typcnt[3], &tpospt[
	    1], &typept[1], &ier);
    if (ier > 0) {
	goto L9102;
    }



/*        Remplissage des tables d'assemblage */
/*      REMPLISSAGE DE TASEMH : POUR MATRICE HESSIENNE */
/*                     TASEMG:  POUR MATRICE DES CONTRAINTES */


    mmtabas_(nbrpnt, nbcntr, ndimen, nbrcrb, ordher, ncflim, &typcnt[3], &
	    tpospt[1], &tasemh[ioftah], &tasemg[ioftag], &hdecal, &hdimen, &
	    gdimen, &ier);
    if (ier > 0) {
	goto L9102;
    }

/*     Allocations dependant de HDIMEN, GDIMEN */

    dimhpo = hdimen << 1;
    macrai4_(&dimhpo, &c__100, hposit, &iofhpo, &ier);
    if (ier > 0) {
	goto L9103;
    }
    dimgpo = gdimen * 3;
    macrai4_(&dimgpo, &c__50, gposit, &iofgpo, &ier);
    if (ier > 0) {
	goto L9103;
    }
    dimmpo = gdimen << 1;
    macrai4_(&dimmpo, &c__100, mposit, &iofmpo, &ier);
    if (ier > 0) {
	goto L9103;
    }


/*    REMPLISSAGE DES TABLES DE POSITIONNEMENT */


    mmtposi_(ndimen, nbrpnt, nbcntr, nbrcrb, ordher, &hdimen, &gdimen, ncflim,
	     &tasemh[ioftah], &tasemg[ioftag], &tpospt[1], &typcnt[3], &
	    hdecal, &hposit[iofhpo], &gposit[iofgpo], &mposit[iofmpo], &
	    hnstoc, &mnstoc, &gnstoc, &ier);
    if (ier > 0) {
	goto L9102;
    }


/*    Remplissage de la table POSUIV qui donne le premier terme */
/*    du profil qui suit le terme courant dans la meme colone */
/*    de la matrice MATSYS */

    macrai4_(&hnstoc, &c__400, hposui, &iofhps, &ier);
    if (ier > 0) {
	goto L9103;
    }
    macrai4_(&mnstoc, &c__100, matsui, &iofmps, &ier);
    if (ier > 0) {
	goto L9103;
    }

    mmposui_(&hdimen, &hnstoc, &hposit[iofhpo], &hposui[iofhps], &ier);
    if (ier > 0) {
	goto L9102;
    }
    if (gdimen > 0) {
	mmposui_(&gdimen, &mnstoc, &mposit[iofmpo], &matsui[iofmps], &ier);
	if (ier > 0) {
	    goto L9102;
	}
    }


/*     Assemblage de la matrice hessienne */
/*     et le vecteur du second membre correspondant */

    macrar8_(&hnstoc, &c__4000, matsyh, &iofmah, &ier);
    if (ier > 0) {
	goto L9103;
    }
    macrar8_(&hdimen, &c__100, vecsyh, &iofveh, &ier);
    if (ier > 0) {
	goto L9103;
    }

    mmasemh_(ndimen, nbrpnt, nbrcrb, ncflim, ordher, &hdimen, &hnstoc, &
	    tabpar[1], &hdecal, &tpospt[1], &typept[1], tabint, &tasemh[
	    ioftah], &hposit[iofhpo], &math1[1], &math2[1], &math3[1], &
	    tabpnt[tabpnt_offset], &tbpoid[1], &vpoids[1], &matsyh[iofmah], &
	    vecsyh[iofveh], &ier);
    if (ier > 0) {
	goto L9102;
    }


/*     Assemblage de la matrice des contraintes */
/*     et le vecteur du second membre correspondant */


    if (*nbcntr > 0) {

	macrar8_(&gnstoc, &c__400, matsyg, &iofmag, &ier);
	if (ier > 0) {
	    goto L9103;
	}
	macrar8_(&gdimen, &c__100, vecsyg, &iofveg, &ier);
	if (ier > 0) {
	    goto L9103;
	}

	mmasemg_(ndimen, nbrpnt, nbcntr, nbrcrb, ncflim, ordher, &gdimen, &
		gnstoc, cblong, &tabpar[1], &tpospt[1], tabint, &typcnt[3], &
		tabcnt[tabcnt_offset], &tasemh[ioftah], &tasemg[ioftag], &
		gposit[iofgpo], &tabpnt[tabpnt_offset], &ttheta[ttheta_offset]
		, &tfthet[tfthet_offset], &hdecal, &matsyg[iofmag], &vecsyg[
		iofveg], &ier);
	if (ier > 0) {
	    goto L9102;
	}
    }


/*     Resolution du systeme */


    macrar8_(&hdimen, &c__100, vecsol, &iofvso, &ier);
    if (ier > 0) {
	goto L9103;
    }

    mmresol_(&hdimen, &gdimen, &hnstoc, &gnstoc, &mnstoc, &matsyh[iofmah], &
	    matsyg[iofmag], &vecsyh[iofveh], &vecsyg[iofveg], &hposit[iofhpo],
	     &hposui[iofhps], &gposit[iofgpo], &matsui[iofmps], &mposit[
	    iofmpo], &vecsol[iofvso], &ier);
    if (ier > 0) {
	goto L9102;
    }


/*     Desassemblage du vecteur solution */


    mmdesab_(ndimen, nbrcrb, ncflim, &hdecal, &tasemh[ioftah], &hdimen, &
	    vecsol[iofvso], &crbtab[crbtab_offset], &ier);
    if (ier > 0) {
	goto L9102;
    }



/*     Reduction du degre */

    ncfmin = (*ordher << 1) + 2;
/* Computing MIN */
    d__1 = vpoids[2] / 10, d__2 = *cblong / 1000;
    epsilo = min(d__1,d__2);

    if (*nbcntr == 0) {

	i__1 = *nbrcrb;
	for (icrb = 1; icrb <= i__1; ++icrb) {

	    mmcvinv_(ncflim, ndimen, ncflim, &crbtab[(icrb * crbtab_dim2 + 1) 
		    * crbtab_dim1 + 1], &vecsol[iofvso]);

	    mmtrpjj_(ncflim, ndimen, ncflim, &epsilo, ordher, &vecsol[iofvso],
		     e1bid, &e2bid, &ncftab[icrb]);
	    if (ncftab[icrb] < ncfmin) {
		ncftab[icrb] = ncfmin;
	    }
	}

    } else {

	icnt = 1;

	i__1 = *nbrcrb;
	for (icrb = 1; icrb <= i__1; ++icrb) {

	    while(icnt < *nbcntr && tabpar[typcnt[(icnt << 1) + 1]] <= tabint[
		    icrb - 1]) {
		++icnt;
	    }

	    if (tabpar[typcnt[(icnt << 1) + 1]] <= tabint[icrb - 1] || tabpar[
		    typcnt[(icnt << 1) + 1]] >= tabint[icrb]) {

		mmcvinv_(ncflim, ndimen, ncflim, &crbtab[(icrb * crbtab_dim2 
			+ 1) * crbtab_dim1 + 1], &vecsol[iofvso]);

		mmtrpjj_(ncflim, ndimen, ncflim, &epsilo, ordher, &vecsol[
			iofvso], e1bid, &e2bid, &ncftab[icrb]);
		if (ncftab[icrb] < ncfmin) {
		    ncftab[icrb] = ncfmin;
		}
	    } else {
		ncftab[icrb] = *ncflim;
	    }
	}
    }

/*     Calcul les valeurs des criteres integraux */


    mmvacri_(ndimen, nbrcrb, &ncftab[1], ordher, &crbtab[crbtab_offset], 
	    tabint, ncflim, &math1[1], &math2[1], &math3[1], &tvcint[4], &ier)
	    ;
    if (ier > 0) {
	goto L9102;
    }


/*      Conversion des courbes hermite-jacobi en canonique */
/*      sur (-1,1) */


    bornes[0] = -1.;
    bornes[1] = 1.;
    mmhjcan_(ndimen, nbrcrb, &ncftab[1], ordher, ncflim, &crbtab[
	    crbtab_offset], tabint, &crbtab[crbtab_offset], iercod);


    goto L9999;

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


L9101:
    *iercod = 1;
    goto L9999;
L9102:
    *iercod = 2;
    if (ier == 3) {
	*iercod = 3;
    }
    goto L9999;

L9103:
    *iercod = 3;
    goto L9999;


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

L9999:


/* ___ DESALLOCATION, ... */


    macrdi4_(&dimtah, &c__400, tasemh, &ioftah, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdi4_(&dimtag, &c__100, tasemg, &ioftag, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdi4_(&dimhpo, &c__100, hposit, &iofhpo, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdi4_(&dimgpo, &c__50, gposit, &iofgpo, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdi4_(&dimmpo, &c__100, mposit, &iofmpo, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdi4_(&hnstoc, &c__400, hposui, &iofhps, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdi4_(&mnstoc, &c__100, matsui, &iofmps, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(&hnstoc, &c__4000, matsyh, &iofmah, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(&hdimen, &c__100, vecsyh, &iofveh, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(&gnstoc, &c__400, matsyg, &iofmag, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(&gdimen, &c__100, vecsyg, &iofveg, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }
    macrdr8_(&hdimen, &c__100, vecsol, &iofvso, &ier);
    if (*iercod == 0 && ier > 0) {
	*iercod = 3;
    }


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

