C ISOVA1    SOURCE    PV        09/03/12    21:25:33     6325           
      SUBROUTINE ISOVA1(MCHELM,XISO,XTOL,MELEME)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : ISOVA1
C DESCRIPTION : Construit le maillage d'une isovaleur d'un champ par 
C               éléments
C
C
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C VERSION    : v1, 17/12/2008, version initiale
C HISTORIQUE : v1, 17/12/2008, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
-INC CCOPTIO
-INC CCGEOME
-INC CCREEL
-INC SMCOORD
-INC SMELEME
-INC SMCHAML
-INC SMLENTI
*
* Segments ajustables 1D contenant les noeuds des éléments créés ainsi
* que leur couleur 
* ELEM(1) contient des POI1
* ELEM(2) contient des SEG2
* ELEM(3) contient des TRI3
* ELEM(4) contient des TET4
* ELEM(5) contient des QUA4
*
      PARAMETER (NTYEL=5)
      SEGMENT ELEMS
      POINTEUR ELEM(NTYEL).MLENTI
      ENDSEGMENT
      SEGMENT MELEMS
      POINTEUR IPT(NTYEL).MELEME
      ENDSEGMENT
*
      CHARACTER*8 MCHA
      INTEGER IMPR,IRET
*
      INTEGER ITYPL(NTYEL)
      DATA ITYPL/1,2,4,23,8/
*     
* Executable statements
*
      IMPR=0
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans isova1.eso' 
*
* Initialisation des objets possiblement créés
*
      SEGACT MCOORD*MOD
      SEGINI ELEMS
      DO ITYEL=1,NTYEL
         JG=0
         SEGINI MLENTI
         ELEM(ITYEL)=MLENTI
      ENDDO
*
* Parcours du CHAMELEM
*
      SEGACT MCHELM
      N1=IMACHE(/1)
      DO I1=1,N1
         ITYCHA=INFCHE(I1,6)
         IF (ITYCHA.NE.1) THEN
            MOTERR(1:16)='NOEUDS         '
* 291 2
*Pas de MCHAML de type %m1:16 trouvé
            CALL ERREUR(291)
            RETURN
         ENDIF
         MELEME=IMACHE(I1)
         SEGACT MELEME
         MCHAML=ICHAML(I1)
         SEGACT MCHAML
         CALL ISOVA2(MELEME,MCHAML,XISO,XTOL,ELEMS)
         SEGDES MCHAML
         SEGDES MELEME
      ENDDO
      SEGDES MCHELM
      SEGACT MCOORD
*
* Transformation des segments ajustables en MELEME
*
      SEGINI MELEMS
      NSOUT=0
      NBSOUS=0
      NBREF=0
      DO ITYEL=1,NTYEL
         MLENTI=ELEM(ITYEL)
         JG=LECT(/1)
         IF (JG.GT.0) THEN
            NSOUT=NSOUT+1
            ITYP=ITYPL(ITYEL)
            NBNN=NBNNE(ITYP)
            NBNN1=NBNN+1
            NBELEM=JG/NBNN1
            SEGINI MELEME
            ITYPEL=ITYP
            DO IELEM=1,NBELEM
               DO INN=1,NBNN
                  NUM(INN,IELEM)=LECT((IELEM-1)*NBNN1+INN)
               ENDDO
               ICOLOR(IELEM)=LECT(IELEM*NBNN1)
            ENDDO
            SEGDES MELEME
            MELEMS.IPT(ITYEL)=MELEME
         ENDIF
         SEGSUP MLENTI
      ENDDO
      SEGSUP ELEMS
*
      IF (NSOUT.EQ.1) THEN
         DO ITYEL=1,NTYEL
            IPT1=IPT(ITYEL)
            IF (IPT1.NE.0) THEN
               MELEME=IPT1
            ENDIF
         ENDDO
      ELSE
         NBNN=0
         NBREF=0
         NBSOUS=NSOUT
         NBREF=0
         SEGINI MELEME
         ISOUS=0
         DO ITYEL=1,NTYEL
            IPT1=IPT(ITYEL)
            IF (IPT1.NE.0) THEN
               ISOUS=ISOUS+1
               LISOUS(ISOUS)=IPT1
            ENDIF
         ENDDO
         SEGDES MELEME
      ENDIF
      SEGSUP MELEMS
      RETURN
*
* End of subroutine ISOVA1
*
      END