C COTEMO    SOURCE    PASCAL    12/04/17    21:15:03     7355           
      SUBROUTINE COTEMO(IP1,MFR)
c-----------------------------------------------------------------------
c
c teste les noms des composantes des MCHAML susceptibles d etre crees 
c avec le sous model : on ne veut pas de redondance
c
c-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC SMELEME
-INC SMMODEL
      pointeur nomid1.nomid
      segment NOMLIS
        CHARACTER*8 LESCOM(NTOT)
        CHARACTER*8 lecham(ntot)
      endsegment
*
      character*8 mocham, moref

      imodel = ip1
      ntot = 0 
      segini nomlis
      nfor=formod(/2)
      ithe=0
      CALL PLACE(FORMOD,NFOR,IMAGN,'MAGNETODYNAMIQUE')
      CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION')
      CALL PLACE(FORMOD,NFOR,IELEC,'ELECTROSTATIQUE')
      CALL PLACE(FORMOD,NFOR,ITHEHY,'THERMOHYDRIQUE')
      CALL PLACE(FORMOD,NFOR,IRAYO,'RAYONNEMENT')
      CALL PLACE(FORMOD,NFOR,ICONV,'CONVECTION')
      CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')  
      ithe=ithehy+iconv+ither+irayo

      do lm = 1,22

        MOCOMP=0
        mocham = '        '

        goto (1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
     & 16, 17, 18, 19, 20, 21, 22) lm

   1    NBROBL=1
        NBRFAC=0
        SEGINI NOMID
        LESOBL(1)='SCAL    '
        MOCOMP=NOMID
        mocham = 'RESERVE '
        GOTO 120
*
   2    NBROBL=1
        NBRFAC=0
        SEGINI NOMID
        LESOBL(1)='MAHO    '
        MOCOMP=NOMID
        mocham = 'MAHOOKE '
        GOTO 120
*
   3    NBROBL=1
        NBRFAC=0
        SEGINI NOMID
        LESOBL(1)='TEMP    '
        MOCOMP=NOMID
        mocham = 'RESERVE '
        GOTO 120
*
   4    continue
        GOTO 120
   5    continue
        GOTO 120
*
   6    if(lnomid(1).ne.0) then
         mocomp=lnomid(1)
        else 
         CALL IDDEPL(MFR,IFOUR,MOCOMP,NOBL,NFAC)
         IF (IDIFF.EQ.1) THEN
          nomid = mocomp
          segact,nomid*MOD
          lesobl(1) = TYMODE(1)
          segdes,nomid
         ENDIF
        endif
        mocham = 'DEPLACEM'
        GOTO 120
*
   7    if(lnomid(2).ne.0) then
         mocomp=lnomid(2)
        else 
         CALL IDFORC(MFR,IFOUR,MOCOMP,NOBL,NFAC)
         IF (IDIFF.EQ.1) THEN
          nomid = mocomp
          segact,nomid*MOD
          lesobl(1) = TYMODE(2)
          segdes,nomid
         ENDIF
        endif
        mocham = 'FORCES  '
        GOTO 120
*
   8    continue
        GOTO 120
   9    continue
        GOTO 120
*
  10   if(lnomid(3).ne.0) then
         mocomp=lnomid(3)
        else
         CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
         IF (IDIFF.EQ.1) THEN
          nomid = mocomp
          segact,nomid*MOD
C*8       lesobl(1)(2:7) = TYMODE(1)(1:6)
          lesobl(1)(2:3) = TYMODE(1)(1:2)
          segdes,nomid
         ENDIF
        endif
        mocham = 'GRADIENT'
        GOTO 120
*
  11   if(lnomid(4).ne.0) then
         mocomp=lnomid(4)
        else    
         CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'CONTRAIN'
        GOTO 120
*
  12    if(lnomid(5).ne.0) then
         mocomp=lnomid(5)
        else 
         CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'DEFORMAT'
        GOTO 120
*
  13    if(lnomid(6).ne.0) then
         mocomp=lnomid(6)
        else 
         CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'MATERIAU'
        GOTO 120
*
  14    if(lnomid(7).ne.0) then
         mocomp=lnomid(7)
        else
         CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'CARACTER'
        GOTO 120
*
  15    if(lnomid(8).ne.0) then
         mocomp=lnomid(8)
        else     
         CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'TEMPERAT'
        GOTO 120
*
  16    if(lnomid(9).ne.0) then
          mocomp=lnomid(9)
        else
          CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'PRINCIPA'
        GOTO 120
*
  17    if(lnomid(13).ne.0) then
          mocomp=lnomid(13)
        else
          CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
        endif
        mocham = 'DEFINELA'
        GOTO 120
*
  18    continue
  19    continue
        GOTO 120
*
  20    if(lnomid(10).ne.0) then
         mocomp=lnomid(10)
       else      
        CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
       endif
        mocham = 'VARINTER'
        GOTO 120
*
  21    if(lnomid(11).ne.0) then
         mocomp=lnomid(11)
       else      
         CALL IDGRAF(MFR,IFOUR,MOCOMP,NOBL,NFAC)
       endif
        mocham = 'GRAFLEXI'
        GOTO 120
*
  22  if(lnomid(12).ne.0) then
         mocomp=lnomid(12)
       else      
        CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC)
       endif
        mocham = 'PHASES  '
        GOTO 120
*
 120    CONTINUE
        nomid = mocomp
        if (nomid.gt.0) then
         segact,nomid
         nobl=lesobl(/2)
         nfac=lesfac(/2)
        nto1 = lescom(/2)
        ntot = nto1 + nobl + nfac
*        write(6,*) 'lm ', lm, mocham, nobl, nfac,'nto1 ', nto1,mfr
        segadj nomlis
        do im = 1,(nobl+nfac)
         lecham(nto1 + im) = mocham
         if (im.le.nobl) then
           lescom(nto1 + im) = lesobl(im)
         else
           lescom(nto1 + im) = lesfac(im - nobl)
         endif
        enddo
        segdes,nomid
       endif

      enddo
*
      ntot = lescom(/2)
*      write(6,*) 'ntot -cotemo', ntot
      do 874 in = 1, (ntot - 1)
        moref = lescom(in)
        mocham = lecham(in)
*        write(6,*) 'comp-champ-ref' , in ,moref, mocham
        do jm = (in + 1),ntot
*        write(6,*) 'comp-champ-tes' , jm, lescom(jm), lecham(jm)
         if (lescom(jm).eq.moref)  then
         if(moref.eq.'EPAI'.and.imagn.ne.0) go to 874
         if(moref.eq.'T   '. and.ithe.ne.0) go to 874 
           moterr(1:8) = moref
           moterr(9:16) = lecham(in)
           moterr(17:24) = lecham(jm)
           call erreur(913)
         endif
        enddo
 874  continue

      segsup nomlis
      return
      end