C COML      SOURCE    JK148537  25/12/12    21:15:02     12418          

      SUBROUTINE COML

*-----------------------------------------------------------------------
*                INTEGRATION DES LOIS DE COMPORTEMENT
*-----------------------------------------------------------------------
*    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
*
*  Ne concerne que les formulations MECANIQUE, POREUX, MELANGE, LIAISON
*  DIFFUSION et METALLURGIE.
*-----------------------------------------------------------------------

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

-INC PPARAM
-INC CCOPTIO
-INC SMLENTI
-INC SMCHAML
-INC SMMODEL
-INC SMCOORD
-INC DECHE
C     POINTEUR DES MCHEML EN ENTREE
      SEGMENT llchee(NNN)
      SEGMENT LIMODE(NSM)
C
C     =================================================================
C     LECTURE D'UN MMODEL
C     =================================================================
      CALL LIROBJ('MMODEL  ',IPMODL,1,irt)
      CALL ACTOBJ('MMODEL  ',IPMODL,1)
      IF (IERR.NE.0) RETURN
C
C     DEROULER LE MMODEL POUR NE SELECTIONNER QUE CEUX D'INTERET
      MMODEL = IPMODL
      NSOUS  = KMODEL(/1)
      NSM = NSOUS
      SEGINI,LIMODE
c
      NLIMOD = 0
      NMOMEL = 0
      DO IM = 1, NSOUS
        IMODEL = KMODEL(IM)
        if (cmatee.eq.'ADVECTIO') goto 20
        IF (FORMOD(1)(1:16).EQ.'MECANIQUE       ' .OR.
     &      FORMOD(1)(1:16).EQ.'LIQUIDE         ' .OR.
     &      FORMOD(1)(1:16).EQ.'POREUX          ' .OR.
     &      FORMOD(1)(1:16).EQ.'LIAISON         ' .OR.
     &      FORMOD(1)(1:16).EQ.'DIFFUSION       ' .OR.
     &      FORMOD(1)(1:16).EQ.'METALLURGIE     '  ) THEN
          NLIMOD = NLIMOD+1
          IF (NLIMOD.GT.NSM) THEN
            NSM = NSM * 2
            SEGADJ LIMODE
          ENDIF
          LIMODE(NLIMOD) = IMODEL
        ELSE IF (FORMOD(1)(1:16).EQ. 'MELANGE         ') THEN
          NLIMOD = NLIMOD+1
          IF (NLIMOD.GT.NSM) THEN
            NSM = NSM * 2
            SEGADJ LIMODE
          ENDIF
          LIMODE(NLIMOD) = IMODEL
          nmomel = nmomel + 1
          IF (MATMOD(1)(1:6).NE.'SERIE ') THEN
            IF (IVAMOD(/1).GE.1) THEN
              DO IVM1 = 1,IVAMOD(/1)
                IF (TYMODE(IVM1).EQ.'IMODEL  ') THEN
                  IMODE1 = IVAMOD(IVM1)
                  NLIMOD = NLIMOD+1
                  IF (NLIMOD.GT.NSM) THEN
                    NSM = NSM * 2
                    SEGADJ LIMODE
                  ENDIF
                  LIMODE(NLIMOD) = IMODE1
                ENDIF
              ENDDO
            ENDIF
          ENDIF
        ENDIF
  20    continue
      ENDDO
C
      IF (NLIMOD.LE.0) THEN
        WRITE(IOIMP,*) 'ERREUR ANORMALE : MMODEL VIDE !'
        CALL ERREUR(5)
        RETURN
      ENDIF
C
C     TEST DE NON REDONDANCE DES SOUS-MODELES
      N1 = 1
      DO 1161 IT1 = NLIMOD, 2, -1
        IMODE1 = LIMODE(IT1)
        DO IT2 = (IT1 - 1), 1, -1
          IMODE2 = LIMODE(IT2)
          IF (IMODE1.EQ.IMODE2) THEN
            LIMODE(IT1) = 0
            GOTO 1161
          ELSE IF (IMODE1.IMAMOD.EQ.IMODE2.IMAMOD .AND.
     &          IMODE1.CONMOD(1:LCONMO).EQ.IMODE2.CONMOD(1:LCONMO)) THEN
            LIMODE(IT1) = 0
            GOTO 1161
          ENDIF
        ENDDO
        N1 = N1 + 1
 1161 CONTINUE
C
C     CREATION DU MMODEL DE TRAVAIL (les sous-modeles de formulation 
C     melange sont mis a la fin pour qu'ils soient traites en dernier 
C     car ils dependent des resultats des autres sous-modeles)
      SEGINI,MMODEL
      IT1 = 0
      IT2 = N1 - NMOMEL
      DO IM = 1, NLIMOD
        IMODEL = LIMODE(IM)
        IF (IMODEL.GT.0) THEN
          IF (FORMOD(1)(1:8).NE.'MELANGE ') THEN
            IT1 = IT1 + 1
            KMODEL(IT1) = IMODEL
          ELSE
            IT2 = IT2 + 1
            KMODEL(IT2) = IMODEL
          ENDIF
        ENDIF
      ENDDO
      SEGSUP,LIMODE
      IPMODL=MMODEL
C
C     =================================================================
C     LECTURE DES MCHAML (AU MOINS UN)
C     =================================================================
      NNN    = 2
      SEGINI,llchee
      LACOND = 1
      NBCHEE = 0
 50   CONTINUE
      CALL LIROBJ('MCHAML  ',ipche1,LACOND,irt)
      IF (IERR.NE.0) GOTO 9010
      IF (irt.eq.1) THEN
        NBCHEE=NBCHEE+1
        IF(NBCHEE .GT. NNN)THEN
          NNN=NBCHEE*2+10
          SEGADJ,llchee
        ENDIF
        CALL ACTOBJ('MCHAML  ',ipche1,1)
        IF (IERR.NE.0) GOTO 9010
        CALL REDUAF(ipche1,ipmodl,ipch,0,iret,kerr)
        IF (iret.NE.1) CALL ERREUR(kerr)
        IF (IERR.NE.0) GOTO 9010
        llchee(NBCHEE) = ipch
        LACOND = 0
        GOTO 50
      ENDIF
C
C     =================================================================
C     CREATION DES DECHE
C     =================================================================
      iimel = 500
      CALL oooprl(1)
C     On a besoin du MCOORD plus loin dans doxe.eso
      segact,mcoord
      segini,lilmel
      ijmel=0
      do iem = 1, NBCHEE
        mchelm = llchee(iem)
        n1 = conche(/2)
        n3 = infche(/2)
        do in1 = 1, n1
          mchaml = ichaml(in1)
          n2 = nomche(/2)
          do in2 = 1, n2
            segini deche
            indec  = iem
            ieldec = -1*ielval(in2)
            typdec = typche(in2)
            typree = typdec(1:6).eq.'REAL*8'
            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
            ijmel=ijmel+1
            if (ijmel.gt.iimel)then
              iimel=iimel+500
              segadj lilmel
            endif
            lilmel(ijmel) = deche
          enddo
        enddo
      enddo
      iimel=ijmel
      segadj lilmel
      CALL oooprl(0)
      ipmel= lilmel
C
C     =================================================================
C     Indice des deche pour le champ de sortie
      INDESO = NBCHEE + 1
C
C     Indicateur(s) d'erreur si non nul(s)
      IRETOU = 0
C
      CALL COML2(IPMODL,ipmel,INDESO,IRETOU)
C
C     =================================================================
C     Sortie sur une erreur bloquante
      IF (IERR.GT.0 .OR. IRETOU.NE.0) GOTO 9000
C
C     Construction du MCHAML resultat : sortie normale
      lilmel = ipmel
      iga = 0
      n3 = 0
      kme = 0
*
      DO 107 iol = 1, lilmel(/1)
        deche = lilmel(iol)
        IF (indec.EQ.INDESO) THEN
          iga = iga + 1
          if (iga.eq.1) kme = iol
          n3 = max(n3,infdec(/1))
        ELSE
         segsup deche
         lilmel(iol) = 0
        ENDIF
  107 CONTINUE

      call oooprl(1)
      jg = iga
      segini mlenti
      n1 = iga
      n2 = iga
      L1 = 13
      SEGINI,mchelm
      TITCHE = 'CREE PAR COMP'
      deche = lilmel(kme)
      IFOCHE = ifodec
      CONCHE(1) = condec
      IMACHE(1) = imadec
      DO in3 = 1, infdec(/1)
        INFCHE(1,in3) = infdec(in3)
      ENDDO
      SEGINI,mchaml
      ICHAML(1)=mchaml
      kga = 1
      iga = 0
      DO 108 iol = 1, lilmel(/1)
        deche = lilmel(iol)
        if (deche.eq.0) goto 108
        melval=ABS(ieldec)
        IF (indec.EQ.INDESO) THEN
c... compresse eventuellement le melval s il est constant
          CALL comred(melval)

          do 120 ik=1,kga
            if (imadec.ne.imache(ik)) goto 120
            if (condec(1:LCONMO).ne.conche(ik)(1:NCONCH)) goto 120
            DO in3 = 1, infdec(/1)
              if(INFCHE(ik,in3).ne.infdec(in3)) goto 120
            ENDDO
            mchaml = ichaml(ik)
            kme = lect(ik)
            kme = kme + 1
            NOMCHE(kme) = nomdec
            TYPCHE(kme) = typdec
            IELVAL(kme) = melval
            lect(ik) = kme
            goto 109
 120      continue
          kga = kga + 1
c         IFOCHE = ifodec
          CONCHE(kga) = condec
          IMACHE(kga) = imadec
          DO in3 = 1, infdec(/1)
            INFCHE(kga,in3) = infdec(in3)
          ENDDO
          SEGINI,mchaml
          ICHAML(kga)=mchaml
          NOMCHE(1) = nomdec
          TYPCHE(1) = typdec
          IELVAL(1) = melval
          lect(kga) = 1
        ENDIF
 109    CONTINUE
        SEGSUP,deche
 108  continue

      n1 = kga
      segadj mchelm
      do iga = 1,n1
        mchaml = ichaml(iga)
        n2 = lect(iga)
        segadj mchaml
      enddo
      segdes,mcoord
      call oooprl(0)
C      
      CALL ACTOBJ('MCHAML  ',mchelm,1)
      CALL ECROBJ('MCHAML  ',mchelm)
c      write(ioimp,*) 'sortie normale de coml', mchelm

 9000 CONTINUE
      MMODEL=IPMODL
      SEGSUP,MMODEL
      SEGSUP,lilmel
 9010 CONTINUE
      SEGSUP,llchee

      END