C AFCOUL    SOURCE    CHAT      05/01/12    21:19:17     5004
C=======================================================================
C
C CE MODULE PERMET D'AFFECTER UNE COULEUR SPECIFIQUE POUR CHAQUE
C SOUS-OBJET D'UN ELEMENT DONNE.
C
C           BLEU      : SEG2,TRI3,CUB8,TET4,LIA3
C           ROUGE     : QUA4,PRI6,PYR5,RAC2,LIA4
C           ROSE      : SEG3,TRI6,CU20,TE10,LIA6
C           VERT      : QUA8,PR15,PY13,RAC3,LIA8
C           TURQUOISE : TRI4,QUA5
C           JAUNE     : TRI7,QUA9
C           BLANC     : MULT
C=======================================================================
C
      SUBROUTINE AFCOUL
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
-INC SMELEME

-INC PPARAM
-INC CCOPTIO
C
      DIMENSION ICLET(50)
      DATA ICLET/70,1,3,1,5,3,6,2,5,4,6,2,4,3,3,4,4,1,2,3,4,7,1,3,2,4,
     #  24*7/
      CALL LIROBJ ('MAILLAGE',MELEME,1,IRETOU)
      IF (IERR.NE.0) RETURN
      SEGACT MELEME
      SEGINI ,IPT1=MELEME
      IF (IPT1.LISOUS(/1).NE.0) THEN
       DO 10 I=1,IPT1.LISOUS(/1)
              IPT2=IPT1.LISOUS(I)
              SEGINI ,IPT3=IPT2
              IPT1.LISOUS(I)=IPT3
              IF (IPT3.ITYPEL.NE.0.AND.IPT3.ITYPEL.LE.50) THEN
               DO 15 J=1,IPT3.NUM(/2)
 15             IPT3.ICOLOR(J)=ICLET(IPT3.ITYPEL)
              ENDIF
              SEGDES IPT3
 10    CONTINUE
      ELSE
       IF (IPT1.ITYPEL.NE.0.AND.IPT1.ITYPEL.LE.50) THEN
        DO 20 I=1,IPT1.NUM(/2)
 20           IPT1.ICOLOR(I)=ICLET(IPT1.ITYPEL)
       ENDIF
      ENDIF
      SEGDES MELEME,IPT1
      CALL ECROBJ('MAILLAGE',IPT1)
      RETURN
      END