C COML      SOURCE    FANDEUR   12/07/18    21:15:27     7435           

      SUBROUTINE COML

*-----------------------------------------------------------------------
*            CALCUL COMPORTEMENTS LOCAUX
*-----------------------------------------------------------------------
*    SYNTAXE
* CHES1 = 'COMP' MODL CHET1 CHET2 ;
*
*  MMODEL     |    MODL    OBJET MODELE
*             |    
*  MCHAML     |   CHET1  par exemple : contraintes, phases,
*             | caracteristiques, variables internes, temperatures
*             |         rassemblees dans le champ pour un etat
*             |           initial
*  MCHAML     |    CHET2  : idem etat final
*  on entre ce dont on a besoin 
*  on sort ce qui doit
*-----------------------------------------------------------------------

      IMPLICIT INTEGER (I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC CCOPTIO

-INC SMCHAML
-INC SMMODEL
-INC DECHE
* pointeur des mcheml en entree
      SEGMENT llchee(0)
*
*  LECTURE D'UN MODEL
*
      CALL LIROBJ('MMODEL',IPMODL,1,irt)
      IF (IERR.NE.0) RETURN
*
*  Lecture des mchaml (au moins un)
*
      SEGINI,llchee
      LACOND = 1
 50   CONTINUE
      CALL LIROBJ('MCHAML',ipche1,LACOND,irt)
      IF (IERR.NE.0) GOTO 9010
      IF (irt.ne.0) THEN
*  appel a redu pour rendre compatible le mchaml et le mmodel
        CALL REDUAF(ipche1,ipmodl,ipch,0,iret,kerr)
        IF (iret.NE.1) CALL ERREUR(kerr)
        IF (IERR.NE.0) GOTO 9010
        llchee(**) = ipch
        LACOND = 0
        GOTO 50
      ENDIF

c Pile des melval sous forme de deche
c mise en place du tableau des pointeurs sur les melval : deche
      iimel = 500
      segini,lilmel
      ijmel=0
      do iem = 1, llchee(/1)
        mchelm = llchee(iem)
        segact mchelm
        n1 = conche(/2)
        n3 = infche(/2)
        do in1 = 1, n1
          mchaml = ichaml(in1)
          segact mchaml
          n2 = nomche(/2)
          do in2 = 1, n2
            segini deche
            indec  = iem
            ieldec = ielval(in2)
            typdec = typche(in2)
            nomdec = nomche(in2)
            imadec = imache(in1)
            condec = conche(in1)
            ifodec = ifoche
            do in3 = 1, n3
              infdec(in3) = infche(in1,in3)
            enddo
*        write (ioimp,*) ' coml in1 in2 condec ',in1,in2,condec
*            segdes deche
            ijmel=ijmel+1
            if (ijmel.gt.iimel)then
              iimel=iimel+500
              segadj lilmel
            endif
            lilmel(ijmel) = deche
          enddo
          segdes mchaml
        enddo
        segdes mchelm
      enddo
      iimel=ijmel
      segadj lilmel
      ipmel = lilmel
c Indice des deche pour le champ de sortie
      INDESO = llchee(/1) + 1 
c Indicateur(s) d'erreur si non nul(s)
      IRETOU = 0

      CALL COML2(IPMODL,ipmel,INDESO,IRETOU)

c Sortie sur une erreur bloquante
      IF (IERR.GT.0 .OR. IRETOU.NE.0) GOTO 9000

c Construction du MCHAML resultat : sortie normale
        lilmel = ipmel
        iga = 0
        n3 = 0
        DO 107 iol = 1, lilmel(/1)
          deche = lilmel(iol)
          IF (indec.EQ.INDESO) THEN
            iga = iga + 1
            n3 = max(n3,infdec(/1))
          ENDIF
  107   CONTINUE
        n1 = iga
        n2 = 1
        L1 = 13
        SEGINI,mchelm
        TITCHE = 'CREE PAR COMP'
        iga = 0
        DO 108 iol = 1, lilmel(/1)
          deche = lilmel(iol)
          melval= ieldec
          IF (indec.EQ.INDESO) THEN
            iga = iga + 1
            IFOCHE = ifodec
            CONCHE(iga) = condec
            IMACHE(iga) = imadec
            DO in3 = 1, infdec(/1)
              INFCHE(iga,in3) = infdec(in3)
            ENDDO
            SEGINI,mchaml
            ICHAML(iga)=mchaml
            NOMCHE(1) = nomdec
            TYPCHE(1) = typdec
            IELVAL(1) = melval
c... compresse eventuellement le melval s il est constant
            CALL comred(melval)
            SEGDES,mchaml
          ENDIF
          SEGDES,melval
          SEGSUP,deche
 108    continue
        SEGDES,mchelm
        CALL ECROBJ('MCHAML  ',mchelm)
c        write(ioimp,*) 'sortie normale de coml', mchelm

 9000 CONTINUE
      SEGSUP,lilmel
 9010 CONTINUE
      SEGSUP,llchee
*
      RETURN
      END