Esope source files

   1 : C FUSESU    SOURCE    MAUGIS    07/10/26    21:15:49     5901           
   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 SONT DE TYPE SURFACE
   5 : C
   6 :       SUBROUTINE FUSESU(IPT1,IPT2,IPT3,LTELQ)
   7 :       IMPLICIT INTEGER(I-N)
   8 : -INC CCOPTIO
   9 : -INC SMELEME
  10 :       LOGICAL LTELQ
  11 : 
  12 :       SEGACT IPT1,IPT2
  13 :       NBREF1=IPT1.LISREF(/1)
  14 :       NBREF2=IPT2.LISREF(/1)
  15 :       NBELE1=IPT1.NUM(/2)
  16 :       NBELE2=IPT2.NUM(/2)
  17 :       NBSOUS=0
  18 :       NBELEM=NBELE1 + NBELE2
  19 :       NBNN=IPT1.NUM(/1)
  20 :       IF (NBREF1.EQ.0.OR.NBREF2.EQ.0) GOTO 10
  21 :   20  IPT3=IPT1.LISREF(1)
  22 :       SEGACT IPT3
  23 :       IF (NBREF1.EQ.4) GOTO 30
  24 :   80  CONTINUE
  25 :       IPT4=IPT2.LISREF(1)
  26 :       SEGACT IPT4
  27 :       IF (NBREF2.EQ.1) GOTO 40
  28 :       DO 50 I=2,NBREF2
  29 :       MELEME=IPT2.LISREF(I)
  30 :       SEGACT MELEME
  30 :       CALL FUSELI(IPT4,MELEME,IPT5,LTELQ)
  31 :       SEGDES IPT4,MELEME
  32 :       IPT4=IPT5
  33 :   50  CONTINUE
  34 :       NBREF2=1
  35 :       IF (NBREF1.EQ.1) GOTO 40
  36 :       IPT3=IPT4
  37 :   30  IF (NBREF2.EQ.4) GOTO 60
  38 :       DO 51 I=2,NBREF1
  39 :       MELEME=IPT1.LISREF(I)
  40 :       SEGACT MELEME
  40 :       CALL FUSELI(IPT3,MELEME,IPT5,LTELQ)
  41 :       SEGDES IPT3,MELEME
  42 :       IPT3=IPT5
  43 :   51  CONTINUE
  44 :       NBREF1=1
  45 :       GOTO 80
  46 :   40  CONTINUE
  46 : ***   CALL OUEXCL(IPT3,IPT4,IPT5)   N'EST PLUS UTILE
  47 :       IPT5=0
  48 :       SEGDES IPT3,IPT4
  49 :       IF(IPT5.NE.0) SEGDES IPT5
  50 :       NBREF=1
  51 :       IF(IPT5.EQ.0) NBREF=0
  52 :       SEGINI MELEME
  53 :       IF(IPT5.NE.0) LISREF(1)=IPT5
  54 :       GOTO 100
  55 :   10  NBREF=0
  56 :       SEGINI MELEME
  57 :       GOTO 100
  58 :   60  CONTINUE
  59 :       DO 61 I=1,4
  60 :       IPT3=IPT1.LISREF(I)
  61 :       SEGACT IPT3
  62 :       INI=IPT3.NUM(1,1)
  63 :       IFI=IPT3.NUM(IPT3.NUM(/1),IPT3.NUM(/2))
  64 :       DO 62 J=1,4
  65 :       IPT4=IPT2.LISREF(J)
  66 :       SEGACT IPT4
  67 :       IF (IFI.EQ.IPT4.NUM(1,1)) GOTO 64
  68 :       IF (INI.EQ.IPT4.NUM(1,1)) GOTO 63
  69 :       GOTO 65
  70 :   66  CONTINUE
  71 :       ILONG=IPT3.NUM(/2)
  72 :       IF (ILONG.NE.IPT4.NUM(/2)) GOTO 65
  73 :       DO 90 IL=1,ILONG
  74 :       DO 90 IM=1,IPT3.NUM(/1)
  75 :       IF (IPT3.NUM(IM,IL).NE.IPT4.NUM(IM,IL)) GOTO 65
  76 :   90  CONTINUE
  77 :       GOTO 91
  78 :   67  CONTINUE
  79 :       ILONG=IPT3.NUM(/2)
  80 :       IF (ILONG.NE.IPT4.NUM(/2)) GOTO 65
  81 :       DO 92 IL=1,ILONG
  82 :       DO 92 IM=1,IPT3.NUM(/1)
  83 :       IF (IPT3.NUM(IM,IL).NE.IPT4.NUM(IPT3.NUM(/1)+1-IM,ILONG+1-IL))
  84 :      #  GOTO 65
  85 :   92  CONTINUE
  86 :       GOTO 91
  87 :   63  IF (IFI.EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 66
  88 :       GOTO 65
  89 :   64  IF (INI.EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 67
  90 :   65  SEGDES IPT4
  91 :   62  CONTINUE
  92 :       SEGDES IPT3
  93 :   61  CONTINUE
  94 :       GOTO 80
  95 :   91  NBREF=4
  96 :       SEGINI MELEME
  97 :       SEGDES IPT3,IPT4
  98 :       I1=I
  99 :       I2=J
 100 :       LISREF(1)=IPT1.LISREF(MOD(I1+1,4)+1)
 101 :       LISREF(3)=IPT2.LISREF(MOD(I2+1,4)+1)
 102 :       IPT3=IPT1.LISREF(MOD(I1+2,4)+1)
 103 :       IPT4=IPT2.LISREF(MOD(I2,4)+1)
 104 :       SEGACT IPT3,IPT4
 105 :       IF (IPT3.NUM(1,1).EQ.IPT4.NUM(1,1)) GOTO 70
 106 :       IF (IPT3.NUM(1,1).EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 70
 107 :       IF (IPT4.NUM(1,1).EQ.IPT3.NUM(IPT3.NUM(/1),IPT3.NUM(/2))) GOTO 70
 108 :       IF (IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2)).EQ.IPT3.NUM(IPT3.NUM(/1),
 109 :      # IPT3.NUM(/2))) GOTO 70
 110 :       GOTO 71
 111 :   70  CONTINUE
 111 :       CALL FUSELI(IPT3,IPT4,IPT5,LTELQ)
 112 :       SEGDES IPT3,IPT4
 113 :       LISREF(2)=IPT5
 114 :       SEGDES IPT5
 115 :       IPT3=IPT1.LISREF(MOD(I1   ,4)+1)
 116 :       IPT4=IPT2.LISREF(MOD(I2+2 ,4)+1)
 117 :       SEGACT IPT3,IPT4
 117 :       CALL FUSELI(IPT4,IPT3,IPT5,LTELQ)
 118 :       SEGDES IPT3,IPT4
 119 :       LISREF(4)=IPT5
 120 :       SEGDES IPT5
 121 :       GOTO 100
 122 :   71  CONTINUE
 123 :       SEGDES IPT3,IPT4
 124 :       IPT3=IPT1.LISREF(MOD(I1+2,4)+1)
 125 :       IPT4=IPT2.LISREF(MOD(I2+2,4)+1)
 126 :       SEGACT IPT3,IPT4
 126 :       CALL FUSELI(IPT3,IPT4,IPT5,LTELQ)
 127 :       SEGDES IPT3,IPT4
 128 :       LISREF(2)=IPT5
 129 :       SEGDES IPT5
 130 :       IPT3=IPT1.LISREF(MOD(I1,4)+1)
 131 :       IPT4=IPT2.LISREF(MOD(I2,4)+1)
 132 :       SEGACT IPT3,IPT4
 132 :       CALL FUSELI(IPT3,IPT4,IPT5,LTELQ)
 133 :       SEGDES IPT3,IPT4
 134 :       LISREF(4)=IPT5
 135 :       SEGDES IPT5
 136 :       GOTO 100
 137 : 
 138 :  100  CONTINUE
 139 :       ITYPEL=IPT1.ITYPEL
 140 :       DO 101 I=1,NBNN
 141 :       DO 102 J=1,NBELE1
 142 :  102  NUM(I,J)=IPT1.NUM(I,J)
 143 :       DO 103 J=1,NBELE2
 144 :  103  NUM(I,J+NBELE1)=IPT2.NUM(I,J)
 145 :  101  CONTINUE
 146 :       IPT3=MELEME
 147 :       DO 110 I=1,NBELE1
 148 :               ICOLOR(I)=IPT1.ICOLOR(I)
 149 :   110 CONTINUE
 150 :       DO 120 I=1,NBELE2
 151 :               ICOLOR(I+NBELE1)=IPT2.ICOLOR(I)
 152 :   120 CONTINUE
 153 :       RETURN
 154 :       END
 155 : 
 156 :