C COMOUW    SOURCE    FANDEUR   12/07/18    21:15:30     7435           
      SUBROUTINE COMOUW(iqmod,ipcon,INDESO,ipil,iwrk52,iwrk53,
     &iretou,iwr522)
*-------------------------------------------------
* identifie les melval de la pile 
*  - recherche d abord ceux lies au modele
*  - puis tous les autres rang
* les active
* !!!!!!!
* points delicats : evite de passer certaines composantes de
* constituants differents de celui du modele :
* dans tous les cas, caracteristiques materiau et geometrique,
* de plus pour la mecanique, contraintes,
* variables internes et deformations inelastiques. 
* cependant pour les autres on croise les doigts en esperant que les noms
* de composantes correspondent a un seul constituant
* pas de garde fou 
* puis suivant les formulations cree les deche associes 
* aux noms de composantes des mchaml attendus en sortie
* (le rang est INDESO)
*-------------------------------------------------
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
-INC SMMODEL
-INC SMCHAML
-INC DECHE
       logical nouvid
c
      nouvid = .true.
      lilcon = ipcon
      wrk53 = iwrk53
c
        imodel = iqmod

*-------------------------------------------------
      call comou2(iqmod,INDESO,ipil,iwrk52,iwrk53,iwr522)

      liluc = ipil
      iiluc= liluc(/1)
      ijluc = iiluc
      wrk52  = iwrk52
      wrk522 = iwr522
      nexo = exova0(/1)
c
      do icon = 1,lilcon(/1)
        deche = lilcon(icon)    

C* Cas du test pouvant arriver ?
        if (deche.LE.0) GOTO 40
*      write (6,*) ' comouw condec ',condec,' conmod ',conmod
* recherche du nom de composante parmi celles qui existent
* 
       do juc = 1,ijluc

         domdec = liluc(juc)
**         segact domdec*nomod

         nomid  = jnomid
C Cas du test ci-dessous puvant arriver ?
         if (nomid.le.0) goto 35
         nobl = lesobl(/2)
         nfac = lesfac(/2)
         pilnec = jilnec
**         write(6,*)' juc domdec nomid', juc ,domdec,nomid
**         segact nomid*nomod
**         segact pilnec*mod
*        write(6,*) 'nomid ', juc,domdec, nomid , nobl
         if (nobl.gt.0) then
          do 30 jm =1,nobl
           if (nomdec.ne.lesobl(jm)) goto 30
            if (juc.eq.13.or.juc.eq.14) then
              if (condec.eq.conmod) then
                pilobl(jm,indec)=deche
                melval = ieldec
                segact melval
                 goto 40
              endif
              if (FORMOD(1).EQ.'MELANGE'.and.cmate.eq.'PARALLEL'
     &.and.indec.eq.indeso) then
                segini,dec1=deche
                dec1.condec=conmod
*                write(6,*) nomdec,indec,condec,conmod
                pilobl(jm,indec)=dec1
                 goto 40
              endif
            elseif (FORMOD(1).EQ.'MECANIQUE'.and.
     & (juc.eq.11.or.juc.eq.20.or.juc.eq.24)) then
              if (condec.eq.conmod) then
                pilobl(jm,indec)=deche
                melval = ieldec
              segact melval
**              segact melval*nomod
                goto 40
              endif
            else
                pilobl(jm,indec)=deche
                melval = ieldec
              segact melval
                goto 40
            endif 
  30      continue
         endif
         if (nfac.gt.0) then
          do 31 jm =1,nfac
            if (nomdec.ne.lesfac(jm)) goto 31
             if (juc.eq.13.or.juc.eq.14) then
              if (condec.eq.conmod) then
                pilfac(jm,indec)=deche
                melval = ieldec
              segact melval
                goto 40
              endif
             elseif (FORMOD(1).EQ.'MECANIQUE'.and.
     & (juc.eq.11.or.juc.eq.20.or.juc.eq.24)) then
              if (condec.eq.conmod) then
                pilfac(jm,indec)=deche
                melval = ieldec
              segact melval
                goto 40
              endif
             else
                pilfac(jm,indec)=deche
                melval = ieldec
              segact melval
                goto 40
             endif 
  31      continue
         endif

********          segdes nomid,pilnec
  35    continue
***********        segdes domdec
      enddo

* pas dans les listes : reajuster wrk52

        nsca = scal0(/1)
        ndep = depl0(/1)
        nfor = forc0(/1)
        ngra = grad0(/1)
        nstrs = SIG0(/1)
        ndefo = DEPST(/1)
        ncara = XMAT(/1)
        ncarb = XCARB(/1)
        ntur = ture0(/1)
        npri = prin0(/1)
        nmah = maho0(/1)
        nhot = hota0(/1) 
        nvari = VAR0(/1)
        ngrf = graf0(/1)
        nrhi = rhas0(/1)
        ndein = DEFP(/1)
        nparex=PAREX0(/1)
*
      if (nouvid) then 
        nouvid = .false.
* creation d un nomid et du pilnec
        nbrobl=1 
        nbrfac = 0
        segini nomid
        lesobl(1) = nomdec
****        segdes nomid
        segini domdec
        ijluc=ijluc+1
        if(ijluc.gt.iiluc) then
           iiluc=iiluc+1
            segadj liluc
        endif
        liluc(ijluc)=domdec
        jnomid = nomid
        mobl = 1
        mfac = 0
        mran = INDESO
        segini pilnec
        jilnec = pilnec
        pilobl(1,indec) = deche
        melval = ieldec
******        segact melval*nomod
              segact melval
        nexo = nexo + 1
*******        segdes pilnec
*
        segadj wrk52,wrk522
        typexo(nexo) = typdec
        conexo(nexo) = condec
        nomexo(nexo) = nomdec
c        write(6,*) ' comouw ajout 1 ', pilnec ,domdec,nomid, icon 
c        write(6,*) 'suite',mobl,deche, nomdec, nexo ,liluc(/1)
        goto 40
  
      else
        knmid = ijluc
        domdec = liluc(knmid)
*pv     segact domdec*mod
c         write(6,*) 'ajouts' ,deche,nomdec,domdec,jnomid,icon 
        nomid = jnomid
*pv     segact nomid*mod
        nbrobl = lesobl(/2) + 1
        nbrfac = 0
        segadj nomid
        jnomid = nomid
        lesobl(nbrobl) = nomdec         
        pilnec = jilnec
*pv     segact pilnec*mod
        mobl = nbrobl
        mfac = 0 
        mran = indeso
        segadj pilnec
        jilnec = pilnec
        pilobl(mobl,indec) = deche
        melval = ieldec
              segact melval
********        segact melval*nomod
        nexo = nexo + 1
        segadj wrk52,wrk522
        typexo(nexo) = typdec
        conexo(nexo) = condec
        nomexo(nexo) = nomdec
*        write(6,*) ' comouw ajout 2 ', pilnec ,nomid
*        write(6,*) 'suite',mobl,deche, nomdec, melval,nexo ,knmid
********        segdes nomid,pilnec,domdec
        goto 40 
      endif

      moterr(1:16) = condec
      moterr(17:24) = nomdec
      interr(1) = 1 
*      write(6,*) ' comouw : pb classer ' , nomdec , deche
      call erreur(943)
       return

  40   continue
      enddo
*
*-------------------------------------------------
c
      ipil = liluc
      iwrk52 = wrk52
c
      RETURN 
      END