/* MFMCA9.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"
#ifdef WNT
#include <MathBase.h>
#else 
#define  __MathBase_API
#endif
/* Subroutine */ __MathBase_API int mmfmca9_(ndimax, ncfumx, ncfvmx, ndimen, ncoefu, ncoefv, 
	tabini, tabres)
integer *ndimax, *ncfumx, *ncfvmx, *ndimen, *ncoefu, *ncoefv;
doublereal *tabini, *tabres;
{
    /* System generated locals */
    integer tabini_dim1, tabini_dim2, tabini_offset, tabres_dim1, tabres_dim2,
	     tabres_offset, i__1, i__2, i__3;

    /* Local variables */
    static integer i__, j, k, ilong;
    extern /* Subroutine */ int mcrfill_();



/* < */
/* **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 : */
/*     ---------- */
/*        Compression d' un tableau de donnees en un tableau ne */
/*        contenant que l' essentiel (Le tableau d' entree n' est */
/*        pas ecrase). */

/*     MOTS CLES : */
/*     ----------- */
/*     TOUS, MATH_ACCES:: CARREAU&, COMPRESSION, &CARREAU */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*        NDIMAX: Dimension maxi de l' espace. */
/*        NCFUMX: Degre maximal +1 du tableau en u. */
/*        NCFVMX: Degre maximal +1 du tableau en v. */
/*        NDIMEN: Dimension de l' espace de travail. */
/*        NCOEFU: Le degre +1 du tableau en u. */
/*        NCOEFV: Le degre +1 du tableau en v. */
/*        TABINI: Le tableau a compacter. */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*        TABRES: Le tableau compacte. */

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

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

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*     L' appel suivant : */

/* CALL MMFMCA9(NDIMAX,NCFUMX,NCFVMX,NDIMEN,NCOEFU,NCOEFV,TABINI,TABINI) 
*/

/*     ou TABINI est un argument d' entree/sortie, est possible pourvu */
/*     que l' appelant ait bien verifie que : */

/*            NDIMAX > NDIMEN, */
/*         ou NDIMAX = NDIMEN et NCFUMX > NCOEFU */
/*         ou NDIMAX = NDIMEN, NCFUMX = NCOEFU et NCFVMX > NCOEFV */

/*     Ces conditions ne sont pas testees dans le programme. */

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     18-01-199O : RBD ; Creation. */
/* > */
/* ********************************************************************** 
*/


    /* Parameter adjustments */
    tabini_dim1 = *ndimax;
    tabini_dim2 = *ncfumx;
    tabini_offset = tabini_dim1 * (tabini_dim2 + 1) + 1;
    tabini -= tabini_offset;
    tabres_dim1 = *ndimen;
    tabres_dim2 = *ncoefu;
    tabres_offset = tabres_dim1 * (tabres_dim2 + 1) + 1;
    tabres -= tabres_offset;

    /* Function Body */
    if (*ndimen == *ndimax) {
	goto L1000;
    }

/* ----------------------- Compression NDIMEN<>NDIMAX ------------------- 
*/

    i__1 = *ncoefv;
    for (k = 1; k <= i__1; ++k) {
	i__2 = *ncoefu;
	for (j = 1; j <= i__2; ++j) {
	    i__3 = *ndimen;
	    for (i__ = 1; i__ <= i__3; ++i__) {
		tabres[i__ + (j + k * tabres_dim2) * tabres_dim1] = tabini[
			i__ + (j + k * tabini_dim2) * tabini_dim1];
/* L300: */
	    }
/* L200: */
	}
/* L100: */
    }
    goto L9999;

/* ----------------------- Compression NDIMEN=NDIMAX -------------------- 
*/

L1000:
    if (*ncoefu == *ncfumx) {
	goto L2000;
    }
    ilong = (*ndimen << 3) * *ncoefu;
    i__1 = *ncoefv;
    for (k = 1; k <= i__1; ++k) {
	mcrfill_(&ilong, &tabini[(k * tabini_dim2 + 1) * tabini_dim1 + 1], &
		tabres[(k * tabres_dim2 + 1) * tabres_dim1 + 1]);
/* L500: */
    }
    goto L9999;

/* ----------------- Compression NDIMEN=NDIMAX,NCOEFU=NCFUMX ------------ 
*/

L2000:
    ilong = (*ndimen << 3) * *ncoefu * *ncoefv;
    mcrfill_(&ilong, &tabini[tabini_offset], &tabres[tabres_offset]);
    goto L9999;

/* ---------------------------- The end --------------------------------- 
*/

L9999:
    return 0;
} /* mmfmca9_ */

