C FUSESU SOURCE MAUGIS 07/10/26 21:15:49 5901 C CE SOUS-PROGRAMME REALISE L'OPERATION "ET" SUR LES DEUX OBJETS C IPT1 ET IPT2 LE RESULTAT EST RANGE DANS IPT3 C IPT1 ET IPT2 SONT DE TYPE SURFACE C SUBROUTINE FUSESU(IPT1,IPT2,IPT3,LTELQ) IMPLICIT INTEGER(I-N) -INC CCOPTIO -INC SMELEME LOGICAL LTELQ SEGACT IPT1,IPT2 NBREF1=IPT1.LISREF(/1) NBREF2=IPT2.LISREF(/1) NBELE1=IPT1.NUM(/2) NBELE2=IPT2.NUM(/2) NBSOUS=0 NBELEM=NBELE1 + NBELE2 NBNN=IPT1.NUM(/1) IF (NBREF1.EQ.0.OR.NBREF2.EQ.0) GOTO 10 20 IPT3=IPT1.LISREF(1) SEGACT IPT3 IF (NBREF1.EQ.4) GOTO 30 80 CONTINUE IPT4=IPT2.LISREF(1) SEGACT IPT4 IF (NBREF2.EQ.1) GOTO 40 DO 50 I=2,NBREF2 MELEME=IPT2.LISREF(I) SEGACT MELEME CALL FUSELI(IPT4,MELEME,IPT5,LTELQ) SEGDES IPT4,MELEME IPT4=IPT5 50 CONTINUE NBREF2=1 IF (NBREF1.EQ.1) GOTO 40 IPT3=IPT4 30 IF (NBREF2.EQ.4) GOTO 60 DO 51 I=2,NBREF1 MELEME=IPT1.LISREF(I) SEGACT MELEME CALL FUSELI(IPT3,MELEME,IPT5,LTELQ) SEGDES IPT3,MELEME IPT3=IPT5 51 CONTINUE NBREF1=1 GOTO 80 40 CONTINUE *** CALL OUEXCL(IPT3,IPT4,IPT5) N'EST PLUS UTILE IPT5=0 SEGDES IPT3,IPT4 IF(IPT5.NE.0) SEGDES IPT5 NBREF=1 IF(IPT5.EQ.0) NBREF=0 SEGINI MELEME IF(IPT5.NE.0) LISREF(1)=IPT5 GOTO 100 10 NBREF=0 SEGINI MELEME GOTO 100 60 CONTINUE DO 61 I=1,4 IPT3=IPT1.LISREF(I) SEGACT IPT3 INI=IPT3.NUM(1,1) IFI=IPT3.NUM(IPT3.NUM(/1),IPT3.NUM(/2)) DO 62 J=1,4 IPT4=IPT2.LISREF(J) SEGACT IPT4 IF (IFI.EQ.IPT4.NUM(1,1)) GOTO 64 IF (INI.EQ.IPT4.NUM(1,1)) GOTO 63 GOTO 65 66 CONTINUE ILONG=IPT3.NUM(/2) IF (ILONG.NE.IPT4.NUM(/2)) GOTO 65 DO 90 IL=1,ILONG DO 90 IM=1,IPT3.NUM(/1) IF (IPT3.NUM(IM,IL).NE.IPT4.NUM(IM,IL)) GOTO 65 90 CONTINUE GOTO 91 67 CONTINUE ILONG=IPT3.NUM(/2) IF (ILONG.NE.IPT4.NUM(/2)) GOTO 65 DO 92 IL=1,ILONG DO 92 IM=1,IPT3.NUM(/1) IF (IPT3.NUM(IM,IL).NE.IPT4.NUM(IPT3.NUM(/1)+1-IM,ILONG+1-IL)) # GOTO 65 92 CONTINUE GOTO 91 63 IF (IFI.EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 66 GOTO 65 64 IF (INI.EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 67 65 SEGDES IPT4 62 CONTINUE SEGDES IPT3 61 CONTINUE GOTO 80 91 NBREF=4 SEGINI MELEME SEGDES IPT3,IPT4 I1=I I2=J LISREF(1)=IPT1.LISREF(MOD(I1+1,4)+1) LISREF(3)=IPT2.LISREF(MOD(I2+1,4)+1) IPT3=IPT1.LISREF(MOD(I1+2,4)+1) IPT4=IPT2.LISREF(MOD(I2,4)+1) SEGACT IPT3,IPT4 IF (IPT3.NUM(1,1).EQ.IPT4.NUM(1,1)) GOTO 70 IF (IPT3.NUM(1,1).EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 70 IF (IPT4.NUM(1,1).EQ.IPT3.NUM(IPT3.NUM(/1),IPT3.NUM(/2))) GOTO 70 IF (IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2)).EQ.IPT3.NUM(IPT3.NUM(/1), # IPT3.NUM(/2))) GOTO 70 GOTO 71 70 CONTINUE CALL FUSELI(IPT3,IPT4,IPT5,LTELQ) SEGDES IPT3,IPT4 LISREF(2)=IPT5 SEGDES IPT5 IPT3=IPT1.LISREF(MOD(I1 ,4)+1) IPT4=IPT2.LISREF(MOD(I2+2 ,4)+1) SEGACT IPT3,IPT4 CALL FUSELI(IPT4,IPT3,IPT5,LTELQ) SEGDES IPT3,IPT4 LISREF(4)=IPT5 SEGDES IPT5 GOTO 100 71 CONTINUE SEGDES IPT3,IPT4 IPT3=IPT1.LISREF(MOD(I1+2,4)+1) IPT4=IPT2.LISREF(MOD(I2+2,4)+1) SEGACT IPT3,IPT4 CALL FUSELI(IPT3,IPT4,IPT5,LTELQ) SEGDES IPT3,IPT4 LISREF(2)=IPT5 SEGDES IPT5 IPT3=IPT1.LISREF(MOD(I1,4)+1) IPT4=IPT2.LISREF(MOD(I2,4)+1) SEGACT IPT3,IPT4 CALL FUSELI(IPT3,IPT4,IPT5,LTELQ) SEGDES IPT3,IPT4 LISREF(4)=IPT5 SEGDES IPT5 GOTO 100 100 CONTINUE ITYPEL=IPT1.ITYPEL DO 101 I=1,NBNN DO 102 J=1,NBELE1 102 NUM(I,J)=IPT1.NUM(I,J) DO 103 J=1,NBELE2 103 NUM(I,J+NBELE1)=IPT2.NUM(I,J) 101 CONTINUE IPT3=MELEME DO 110 I=1,NBELE1 ICOLOR(I)=IPT1.ICOLOR(I) 110 CONTINUE DO 120 I=1,NBELE2 ICOLOR(I+NBELE1)=IPT2.ICOLOR(I) 120 CONTINUE RETURN END