/* MTHETA.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 mmtheta_(ndimen, nptcnt, typcnt, tabcnt, ttheta, tfthet, 
	iercod)
integer *ndimen, *nptcnt, *typcnt;
doublereal *tabcnt, *ttheta, *tfthet;
integer *iercod;
{
    /* System generated locals */
    integer tabcnt_dim1, tabcnt_offset, ttheta_dim1, ttheta_dim2, 
	    ttheta_offset, tfthet_dim1, tfthet_dim2, tfthet_offset, i__1, 
	    i__2, i__3;
    doublereal d__1, d__2, d__3;

    /* Local variables */
    static logical ldbg;
    static doublereal aux11, aux12, aux22, aux13, aux33, aux23, taux1[3], 
	    taux2[3];
    static integer d__;
    static doublereal taux3[3], taux4[6]	/* was [3][2] */, taux5[6]	
	    /* was [3][2] */;
    static integer i__, l;
    static doublereal norme;
    static integer ier;
    extern integer mnfndeb_();
    extern /* Subroutine */ int maermsg_(), mgenmsg_(), mmvncol_(), 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 : */
/*     ---------- */
/*       CALCUL LES VECTEURS DE BASE THETA */
/*       ET LE VECTEUR TFTHET DEPENDANT DE THETA ET DES DONNEES */
/*       CES VECTEURS PERMETTENT D'EXPRIMER LES EXPRESSION DES */
/*       CONTRAINTES DE TANGENCE ET DE COURBURE */

/*     MOTS CLES : */
/*     ----------- */
/*      RESERVE, LISSAGE, VECTEUR, REPERES, CONTRAINTES */

/*     ARGUMENTS D'ENTREE : */
/*     -------------------- */
/*      NDIMEN: DIMENSION DE L'ESPACE */
/*      NPTCNT: NOMBRE DE POINTS CONTRAINTS */
/*      TYPCNT (1,I): CONTIENT L'INDICE DU POINT CONTRAINT */
/*      TYPCNT (2,I)=0 SI CONTRAINTES DE PASSAGE (G0) */
/*                  =1 .............. (G1) */
/*                  =2 .............  (G2) */
/*      TABCNT (*,1,I) VECTEUR DE TANGENCE AU POINT Pi */
/*      TABCNT (*,2,I) VECTEUR DE COURBURE AU POINT Pi */

/*     ARGUMENTS DE SORTIE : */
/*     --------------------- */

/*       TTHETA(*,1,i) vecteur de base theta1 tel que */
/*                     (Ti,theta1i,theta2i) est une base de R3 */
/*                     ou (Ti,theta1i) est une base de R2 */
/*       TTHETA(*,2,i) vecteur de base theta2 tel que */
/*                    (Ti,theta1i,theta2i) est une base de R3 */

/*       TFTHET(*,1,i),TFTHET(*,2,i) fonction des thetas permettant */
/*                    d'exprimer les contraintes de courbure */
/*                    voir (document) */

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


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


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


/* $    HISTORIQUE DES MODIFICATIONS : */
/*     ------------------------------ */
/*     21-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;
    typcnt -= 3;

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

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


    if (*ndimen <= 1) {
	goto L9101;
    }
    for (d__ = 1; d__ <= 3; ++d__) {
	taux1[d__ - 1] = 0.;
	taux2[d__ - 1] = 0.;
    }
    i__1 = *nptcnt;
    for (i__ = 1; i__ <= i__1; ++i__) {
	if (typcnt[(i__ << 1) + 2] >= 1) {

/*    CALCUL LE OU LES VECTEURS THETA */

	    i__2 = *ndimen;
	    for (d__ = 1; d__ <= i__2; ++d__) {
		taux1[d__ - 1] = tabcnt[d__ + ((i__ << 1) + 1) * tabcnt_dim1];
	    }
	    if (*ndimen == 3) {
		mmvncol_(ndimen, taux1, taux2, &ier);
		if (ier > 0) {
		    goto L9101;
		}
	    }
	    if (*ndimen == 2) {
		taux2[0] = 0.;
		taux2[1] = 0.;
		taux2[2] = 1.;
	    }
	    taux3[0] = taux2[1] * taux1[2] - taux2[2] * taux1[1];
	    taux3[1] = taux2[2] * taux1[0] - taux2[0] * taux1[2];
	    taux3[2] = taux2[0] * taux1[1] - taux2[1] * taux1[0];
/* Computing 2nd power */
	    d__1 = taux3[0];
/* Computing 2nd power */
	    d__2 = taux3[1];
/* Computing 2nd power */
	    d__3 = taux3[2];
	    norme = d__1 * d__1 + d__2 * d__2 + d__3 * d__3;
	    norme = abs(norme);
	    for (d__ = 1; d__ <= 3; ++d__) {
		taux4[d__ - 1] = taux3[d__ - 1] / norme;
	    }
	    if (*ndimen == 3) {
		taux4[3] = taux1[1] * taux4[2] - taux1[2] * taux4[1];
		taux4[4] = taux1[2] * taux4[0] - taux1[0] * taux4[2];
		taux4[5] = taux1[0] * taux4[1] - taux1[1] * taux4[0];
/* Computing 2nd power */
		d__1 = taux4[3];
/* Computing 2nd power */
		d__2 = taux4[4];
/* Computing 2nd power */
		d__3 = taux4[5];
		norme = d__1 * d__1 + d__2 * d__2 + d__3 * d__3;
		norme = 1. / norme;
		for (d__ = 1; d__ <= 3; ++d__) {
		    taux4[d__ + 2] *= norme;
		}
	    }
	    i__2 = *ndimen - 1;
	    for (l = 1; l <= i__2; ++l) {
		i__3 = *ndimen;
		for (d__ = 1; d__ <= i__3; ++d__) {
		    ttheta[d__ + (l + i__ * ttheta_dim2) * ttheta_dim1] = 
			    taux4[d__ + l * 3 - 4];
		}
	    }


/*     CALCUL LA TABLE TFTHET */

	    if (typcnt[(i__ << 1) + 2] == 2) {
/* Computing 2nd power */
		d__1 = taux1[0];
		aux11 = d__1 * d__1;
/* Computing 2nd power */
		d__1 = taux1[1];
		aux22 = d__1 * d__1;
		aux12 = taux1[0] * taux1[1];
		if (*ndimen == 3) {
/* Computing 2nd power */
		    d__1 = taux1[2];
		    aux33 = d__1 * d__1;
		    aux13 = taux1[0] * taux1[2];
		    aux23 = taux1[1] * taux1[2];
		    i__2 = *ndimen - 1;
		    for (d__ = 1; d__ <= i__2; ++d__) {
			taux5[d__ * 3 - 3] = (aux33 + aux22) * taux4[d__ * 3 
				- 3] - aux12 * taux4[d__ * 3 - 2] - aux13 * 
				taux4[d__ * 3 - 1];
			taux5[d__ * 3 - 2] = (aux11 + aux33) * taux4[d__ * 3 
				- 2] - aux12 * taux4[d__ * 3 - 3] - aux23 * 
				taux4[d__ * 3 - 1];
			taux5[d__ * 3 - 1] = (aux11 + aux22) * taux4[d__ * 3 
				- 1] - aux13 * taux4[d__ * 3 - 3] - aux23 * 
				taux4[d__ * 3 - 2];
		    }
		}
		if (*ndimen == 2) {
		    i__2 = *ndimen - 1;
		    for (d__ = 1; d__ <= i__2; ++d__) {
			taux5[d__ * 3 - 3] = aux22 * taux4[d__ * 3 - 3] - 
				aux12 * taux4[d__ * 3 - 2];
			taux5[d__ * 3 - 2] = aux11 * taux4[d__ * 3 - 2] - 
				aux12 * taux4[d__ * 3 - 3];
		    }
		}
		i__2 = *ndimen - 1;
		for (l = 1; l <= i__2; ++l) {
		    i__3 = *ndimen;
		    for (d__ = 1; d__ <= i__3; ++d__) {
			tfthet[d__ + (l + i__ * tfthet_dim2) * tfthet_dim1] = 
				taux5[d__ + l * 3 - 4];
		    }
		}
	    }
	}
    }



    goto L9999;

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

L9101:
    *iercod = 1;
    goto L9999;



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

L9999:


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

