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 : -INC CCOPTIO 22 : C 23 : DIMENSION ICLET(50) 24 : 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, 25 : # 24*7/ 25 : CALL LIROBJ ('MAILLAGE',MELEME,1,IRETOU) 26 : IF (IERR.NE.0) RETURN 27 : SEGACT MELEME 28 : SEGINI ,IPT1=MELEME 29 : IF (IPT1.LISOUS(/1).NE.0) THEN 30 : DO 10 I=1,IPT1.LISOUS(/1) 31 : IPT2=IPT1.LISOUS(I) 32 : SEGINI ,IPT3=IPT2 33 : IPT1.LISOUS(I)=IPT3 34 : IF (IPT3.ITYPEL.NE.0.AND.IPT3.ITYPEL.LE.50) THEN 35 : DO 15 J=1,IPT3.NUM(/2) 36 : 15 IPT3.ICOLOR(J)=ICLET(IPT3.ITYPEL) 37 : ENDIF 38 : SEGDES IPT3 39 : 10 CONTINUE 40 : ELSE 41 : IF (IPT1.ITYPEL.NE.0.AND.IPT1.ITYPEL.LE.50) THEN 42 : DO 20 I=1,IPT1.NUM(/2) 43 : 20 IPT1.ICOLOR(I)=ICLET(IPT1.ITYPEL) 44 : ENDIF 45 : ENDIF 46 : SEGDES MELEME,IPT1 46 : CALL ECROBJ('MAILLAGE',IPT1) 47 : RETURN 48 : END 49 : 50 : 51 : 52 :
© Cast3M 2003 - All rights reserved.
Disclaimer