1 : C FUSEVO SOURCE CHAT 07/10/29 21:20:00 5940 2 : C CE SOUS-PROGRAMME REALISE L'OPERATION " ET " SUR LES DEUX OBJETS 3 : C IPT1 ET IPT2 LE RESULTAT EST RANGE DANS IPT3 4 : C IPT1 ET IPT2 DOIVENT ETRE DE TYPE VOLUME 5 : C PAS DE SOUS OBJETS LA 6 : SUBROUTINE FUSEVO(IPT1,IPT2,IPT3,LTELQ) 7 : IMPLICIT INTEGER(I-N) 8 : -INC CCOPTIO 9 : -INC SMELEME 10 : -INC CCGEOME 11 : LOGICAL LTELQ 12 : 13 : NBREF=0 14 : IF (IPT1.LISREF(/1).EQ.0.OR.IPT2.LISREF(/1).EQ.0) GOTO 100 15 : IF (IPT1.LISREF(/1).EQ.1.OR.IPT2.LISREF(/1).EQ.1) NBREF=1 16 : IF (NBREF.EQ.1) GOTO 1 17 : C AU MOINS DEUX REFERENCES CHAQUE 18 : IPT8=IPT1.LISREF(2) 19 : IPT4=IPT2.LISREF(1) 20 : IF (IPT8.EQ.IPT4) GOTO 2 21 : SEGACT IPT8,IPT4 22 : IF (IPT8.LISOUS(/1).EQ.0.OR.IPT4.LISOUS(/1).NE.IPT8.LISOUS(/1)) 23 : # GOTO 1 24 : DO 3 I=1,IPT8.LISOUS(/1) 25 : IF (IPT8.LISOUS(I).NE.IPT4.LISOUS(I)) GOTO 1 26 : 3 CONTINUE 27 : SEGDES IPT8,IPT4 28 : 2 CONTINUE 29 : C OK ON FUSIONNE 30 : NBREF=3 31 : IF (IPT1.LISREF(/1).EQ.2.OR.IPT2.LISREF(/1).EQ.2) NBREF=2 32 : IF (NBREF.EQ.2) GOTO 11 33 : C A REVOIR NE MARCHE QUE SI LE POURTOUR EST FORME D'UN TYPE D'ELEMENT 34 : IPT8=IPT1.LISREF(3) 35 : SEGACT IPT8 36 : IF (IPT1.LISREF(/1).EQ.3) GOTO 4 37 : DO 5 I=4,IPT1.LISREF(/1) 38 : IPT4=IPT1.LISREF(I) 39 : SEGACT IPT4 40 : IF (IPT4.NUM(/2).NE.0) GOTO 6 41 : NBREF=2 42 : SEGDES IPT4 43 : GOTO 11 43 : 6 IF (KSURF(IPT4.ITYPEL).EQ.0) CALL FUSELI(IPT8,IPT4,IPT5,LTELQ) 43 : IF (KSURF(IPT4.ITYPEL).NE.0) CALL FUSESU(IPT8,IPT4,IPT5,LTELQ) 44 : SEGDES IPT8,IPT4 45 : IPT8=IPT5 46 : 5 CONTINUE 47 : 4 CONTINUE 48 : IPT6=IPT2.LISREF(3) 49 : SEGACT IPT6 50 : IF (IPT2.LISREF(/1).EQ.3) GOTO 10 51 : DO 9 I=4,IPT2.LISREF(/1) 52 : IPT4=IPT2.LISREF(I) 53 : SEGACT IPT4 54 : IF (IPT4.NUM(/2).NE.0) GOTO 8 55 : NBREF=2 56 : SEGDES IPT4 57 : GOTO 11 57 : 8 IF (KSURF(IPT4.ITYPEL).EQ.0) CALL FUSELI(IPT6,IPT4,IPT5,LTELQ) 57 : IF (KSURF(IPT4.ITYPEL).NE.0) CALL FUSESU(IPT6,IPT4,IPT5,LTELQ) 58 : SEGDES IPT6,IPT4 59 : IPT6=IPT5 60 : 9 CONTINUE 61 : 10 CONTINUE 61 : CALL OUEXCL(IPT8,IPT6,IPT7) 62 : SEGDES IPT8,IPT6,IPT7 63 : GOTO 11 64 : 1 CONTINUE 65 : C ON EST SENSE TOUT FUSIONNER A VOIR PLUS TARD 66 : NBREF=0 67 : 11 CONTINUE 68 : 100 CONTINUE 69 : C REFERENCES OK : IPT1.LISREF(1) IPT2.LISREF(2) IPT7 70 : NBNN=IPT1.NUM(/1) 71 : NBSOUS=0 72 : NBELE1=IPT1.NUM(/2) 73 : NBELE2=IPT2.NUM(/2) 74 : NBELEM=NBELE1+NBELE2 75 : SEGINI IPT3 76 : IPT3.ITYPEL=IPT1.ITYPEL 77 : IF (NBREF.EQ.0) GOTO 20 78 : IPT3.LISREF(1)=IPT1.LISREF(1) 79 : IPT3.LISREF(2)=IPT2.LISREF(2) 80 : IF (NBREF.EQ.2) GOTO 20 81 : IPT3.LISREF(3)=IPT7 82 : SEGDES IPT7 83 : 20 CONTINUE 84 : DO 21 I=1,NBNN 85 : DO 22 J=1,NBELE1 86 : IPT3.NUM(I,J)=IPT1.NUM(I,J) 87 : 22 CONTINUE 88 : DO 23 J=1,NBELE2 89 : IPT3.NUM(I,J+NBELE1)=IPT2.NUM(I,J) 90 : 23 CONTINUE 91 : 21 CONTINUE 92 : DO 25 I=1,NBELE1 93 : IPT3.ICOLOR(I)=IPT1.ICOLOR(I) 94 : 25 CONTINUE 95 : DO 27 I=1,NBELE2 96 : IPT3.ICOLOR(I+NBELE1)=IPT2.ICOLOR(I) 97 : 27 CONTINUE 98 : RETURN 99 : END 100 : 101 : 102 : 103 : 104 : 105 : 106 : 107 :
© Cast3M 2003 - All rights reserved.
Disclaimer