/* MUNIVT.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
/* Table of constant values */

static doublereal c_b2 = 10.;

/* Subroutine */ __MathBase_API int mmunivt_(ndimen, vector, vecnrm, epsiln, iercod)
integer *ndimen;
doublereal *vector, *vecnrm, *epsiln;
integer *iercod;
{
    /* System generated locals */
    integer i__1;
    doublereal d__1;

    /* Builtin functions */
    double pow__di();

    /* Local variables */
    static integer nchif, iunit, izero;
    static doublereal vnorm;
    static integer ii;
    static doublereal bid;
    extern /* Subroutine */ int maovsr8_();
    static doublereal eps0;
    extern /* Subroutine */ int mvriraz_();
    extern doublereal mzsnorm_();



/* < */
/* **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 DU VECTEUR NORME A PARTIR D'UN VECTEUR QUELCONQUE */
/*        AVEC UNE PRECISION DONNEE PAR L' UTILISATEUR. */

/*     MOTS CLES : */
/*     ----------- */
/*        TOUS, MATH_ACCES :: */
/*        VECTEUR&, NORMALISATION, &VECTEUR */

/*     ARGUMENTS D'ENTREE : */
/*     ------------------ */
/*        NDIMEN   : DIMENSION DE L'ESPACE */
/*        VECTOR : VECTEUR A NORMER */
/*        EPSILN : L' EPSILON EN DESSOUS DUQUEL ON CONSIDERE QUE LA */
/*                 NORME DU VECTEUR EST NULLE. SI EPSILN<=0, UNE VALEUR */
/*                 PAR DEFAUT EST IMPOSEE (10.D-17 SUR VAX). */

/*     ARGUMENTS DE SORTIE : */
/*     ------------------- */
/*        VECNRM : VECTEUR NORME */
/*        IERCOD  101 : LE VECTEUR EST NUL A EPSILN PRES. */
/*                  0 : OK. */

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

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

/*     DESCRIPTION/REMARQUES/LIMITATIONS : */
/*     ----------------------------------- */
/*     VECTOR et VECNRM peuvent etre identiques. */

/*     On calcule la norme du vecteur et on divise chaque composante par 
*/
/*     cette norme. Apres cela on verifie si toutes les composantes du */
/*     vecteur sauf une vaut 0 a la precision machine pres. Dans */
/*     ce cas on met les composantes quasi-nulles a 0.D0. */

/* $    HISTORIQUE DES MODIFICATIONS   : */
/*     -------------------------------- */
/*     14-12-90 : RBD; Correction cas ou une seule composante est */
/*                     significative, appel a MAOVSR8 pour la precision */
/*                     machine. */
/*     11-01-89 : RBD; Correction precision par defaut. */
/*     05-10-88 : RBD; Creation d' apres UNITVT. */
/*     23-01-85 : DH ; Creation version originale de UNITVT. */
/* > */
/* ***********************************************************************
 */


    /* Parameter adjustments */
    --vecnrm;
    --vector;

    /* Function Body */
    *iercod = 0;

/* -------- Precision par defaut : le zero machine 10.D-17 sur Vax ------ 
*/

    maovsr8_(&nchif);
    if (*epsiln <= 0.) {
	i__1 = -nchif;
	eps0 = pow__di(&c_b2, &i__1);
    } else {
	eps0 = *epsiln;
    }

/* ----------------------------- Calcul de la norme --------------------- 
*/

    vnorm = mzsnorm_(ndimen, &vector[1]);
    if (vnorm <= eps0) {
	mvriraz_(ndimen, &vecnrm[1]);
	*iercod = 101;
	goto L9999;
    }

/* ---------------------- Calcul du vecteur norme ----------------------- 
*/

    izero = 0;
    i__1 = (-nchif - 1) / 2;
    eps0 = pow__di(&c_b2, &i__1);
    i__1 = *ndimen;
    for (ii = 1; ii <= i__1; ++ii) {
	vecnrm[ii] = vector[ii] / vnorm;
	if ((d__1 = vecnrm[ii], abs(d__1)) <= eps0) {
	    ++izero;
	} else {
	    iunit = ii;
	}
/* L20: */
    }

/* ------ Cas ou toutes les coordonnees sauf une sont presque nulles ---- 
*/
/* ------------- alors l' une des coordonnees vaut 1.D0 ou -1.D0 -------- 
*/

    if (izero == *ndimen - 1) {
	bid = vecnrm[iunit];
	i__1 = *ndimen;
	for (ii = 1; ii <= i__1; ++ii) {
	    vecnrm[ii] = 0.;
/* L30: */
	}
	if (bid > 0.) {
	    vecnrm[iunit] = 1.;
	} else {
	    vecnrm[iunit] = -1.;
	}
    }

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

L9999:
    return 0;
} /* mmunivt_ */

