Télécharger la plaquette Cast3M


fr en

Télécharger afcoul.eso

Retour à la liste

Numérotation des lignes : 

afcoul

  1. C AFCOUL    SOURCE    CHAT      05/01/12    21:19:17     5004
  2. C=======================================================================
  3. C
  4. C CE MODULE PERMET D'AFFECTER UNE COULEUR SPECIFIQUE POUR CHAQUE
  5. C SOUS-OBJET D'UN ELEMENT DONNE.
  6. C
  7. C           BLEU      : SEG2,TRI3,CUB8,TET4,LIA3
  8. C           ROUGE     : QUA4,PRI6,PYR5,RAC2,LIA4
  9. C           ROSE      : SEG3,TRI6,CU20,TE10,LIA6
  10. C           VERT      : QUA8,PR15,PY13,RAC3,LIA8
  11. C           TURQUOISE : TRI4,QUA5
  12. C           JAUNE     : TRI7,QUA9
  13. C           BLANC     : MULT
  14. C=======================================================================
  15. C
  16.       SUBROUTINE AFCOUL
  17. C
  18. C=======================================================================
  19.       IMPLICIT INTEGER(I-N)
  20. -INC SMELEME
  21.  
  22. -INC PPARAM
  23. -INC CCOPTIO
  24. C
  25.       DIMENSION ICLET(50)
  26.       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,
  27.      #  24*7/
  28.       CALL LIROBJ ('MAILLAGE',MELEME,1,IRETOU)
  29.       IF (IERR.NE.0) RETURN
  30.       SEGACT MELEME
  31.       SEGINI ,IPT1=MELEME
  32.       IF (IPT1.LISOUS(/1).NE.0) THEN
  33.        DO 10 I=1,IPT1.LISOUS(/1)
  34.               IPT2=IPT1.LISOUS(I)
  35.               SEGINI ,IPT3=IPT2
  36.               IPT1.LISOUS(I)=IPT3
  37.               IF (IPT3.ITYPEL.NE.0.AND.IPT3.ITYPEL.LE.50) THEN
  38.                DO 15 J=1,IPT3.NUM(/2)
  39.  15             IPT3.ICOLOR(J)=ICLET(IPT3.ITYPEL)
  40.               ENDIF
  41.               SEGDES IPT3
  42.  10    CONTINUE
  43.       ELSE
  44.        IF (IPT1.ITYPEL.NE.0.AND.IPT1.ITYPEL.LE.50) THEN
  45.         DO 20 I=1,IPT1.NUM(/2)
  46.  20           IPT1.ICOLOR(I)=ICLET(IPT1.ITYPEL)
  47.        ENDIF
  48.       ENDIF
  49.       SEGDES MELEME,IPT1
  50.       CALL ECROBJ('MAILLAGE',IPT1)
  51.       RETURN
  52.       END
  53.  
  54.  
  55.  
  56.  
  57.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales