Sources Esope | Cast3M

fusesu
C FUSESU    SOURCE    CB215821  26/08/24    21:16:41     12622          
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 PPARAM
-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)
      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)
      IPT3=IPT5
  51  CONTINUE
      NBREF1=1
      GOTO 80
  40  CONTINUE
***   CALL OUEXCL(IPT3,IPT4,IPT5)   N'EST PLUS UTILE
      IPT5=0
      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 121 IL=1,ILONG
      DO 90 IM=1,IPT3.NUM(/1)
      IF (IPT3.NUM(IM,IL).NE.IPT4.NUM(IM,IL)) GOTO 65
  90  CONTINUE
  121 CONTINUE
      GOTO 91
  67  CONTINUE
      ILONG=IPT3.NUM(/2)
      IF (ILONG.NE.IPT4.NUM(/2)) GOTO 65
      DO 122 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
  122 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  CONTINUE
  62  CONTINUE
  61  CONTINUE
      GOTO 80
  91  NBREF=4
      SEGINI MELEME
      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)
      LISREF(2)=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)
      LISREF(4)=IPT5
      GOTO 100
  71  CONTINUE
      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)
      LISREF(2)=IPT5
      IPT3=IPT1.LISREF(MOD(I1,4)+1)
      IPT4=IPT2.LISREF(MOD(I2,4)+1)
      SEGACT IPT3,IPT4
      CALL FUSELI(IPT3,IPT4,IPT5,LTELQ)
      LISREF(4)=IPT5
      GOTO 100
 
 100  CONTINUE
      ITYPEL=IPT1.ITYPEL
      DO 101 I=1,NBNN
      DO 102 J=1,NBELE1
      NUM(I,J)=IPT1.NUM(I,J)
  102 CONTINUE
      DO 103 J=1,NBELE2
      NUM(I,J+NBELE1)=IPT2.NUM(I,J)
  103 CONTINUE
 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
      END