Télécharger fusesu.eso

Retour à la liste

Numérotation des lignes :

  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
  31. CALL FUSELI(IPT4,MELEME,IPT5,LTELQ)
  32. SEGDES IPT4,MELEME
  33. IPT4=IPT5
  34. 50 CONTINUE
  35. NBREF2=1
  36. IF (NBREF1.EQ.1) GOTO 40
  37. IPT3=IPT4
  38. 30 IF (NBREF2.EQ.4) GOTO 60
  39. DO 51 I=2,NBREF1
  40. MELEME=IPT1.LISREF(I)
  41. SEGACT MELEME
  42. CALL FUSELI(IPT3,MELEME,IPT5,LTELQ)
  43. SEGDES IPT3,MELEME
  44. IPT3=IPT5
  45. 51 CONTINUE
  46. NBREF1=1
  47. GOTO 80
  48. 40 CONTINUE
  49. *** CALL OUEXCL(IPT3,IPT4,IPT5) N'EST PLUS UTILE
  50. IPT5=0
  51. SEGDES IPT3,IPT4
  52. IF(IPT5.NE.0) SEGDES IPT5
  53. NBREF=1
  54. IF(IPT5.EQ.0) NBREF=0
  55. SEGINI MELEME
  56. IF(IPT5.NE.0) LISREF(1)=IPT5
  57. GOTO 100
  58. 10 NBREF=0
  59. SEGINI MELEME
  60. GOTO 100
  61. 60 CONTINUE
  62. DO 61 I=1,4
  63. IPT3=IPT1.LISREF(I)
  64. SEGACT IPT3
  65. INI=IPT3.NUM(1,1)
  66. IFI=IPT3.NUM(IPT3.NUM(/1),IPT3.NUM(/2))
  67. DO 62 J=1,4
  68. IPT4=IPT2.LISREF(J)
  69. SEGACT IPT4
  70. IF (IFI.EQ.IPT4.NUM(1,1)) GOTO 64
  71. IF (INI.EQ.IPT4.NUM(1,1)) GOTO 63
  72. GOTO 65
  73. 66 CONTINUE
  74. ILONG=IPT3.NUM(/2)
  75. IF (ILONG.NE.IPT4.NUM(/2)) GOTO 65
  76. DO 90 IL=1,ILONG
  77. DO 90 IM=1,IPT3.NUM(/1)
  78. IF (IPT3.NUM(IM,IL).NE.IPT4.NUM(IM,IL)) GOTO 65
  79. 90 CONTINUE
  80. GOTO 91
  81. 67 CONTINUE
  82. ILONG=IPT3.NUM(/2)
  83. IF (ILONG.NE.IPT4.NUM(/2)) GOTO 65
  84. DO 92 IL=1,ILONG
  85. DO 92 IM=1,IPT3.NUM(/1)
  86. IF (IPT3.NUM(IM,IL).NE.IPT4.NUM(IPT3.NUM(/1)+1-IM,ILONG+1-IL))
  87. # GOTO 65
  88. 92 CONTINUE
  89. GOTO 91
  90. 63 IF (IFI.EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 66
  91. GOTO 65
  92. 64 IF (INI.EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 67
  93. 65 SEGDES IPT4
  94. 62 CONTINUE
  95. SEGDES IPT3
  96. 61 CONTINUE
  97. GOTO 80
  98. 91 NBREF=4
  99. SEGINI MELEME
  100. SEGDES IPT3,IPT4
  101. I1=I
  102. I2=J
  103. LISREF(1)=IPT1.LISREF(MOD(I1+1,4)+1)
  104. LISREF(3)=IPT2.LISREF(MOD(I2+1,4)+1)
  105. IPT3=IPT1.LISREF(MOD(I1+2,4)+1)
  106. IPT4=IPT2.LISREF(MOD(I2,4)+1)
  107. SEGACT IPT3,IPT4
  108. IF (IPT3.NUM(1,1).EQ.IPT4.NUM(1,1)) GOTO 70
  109. IF (IPT3.NUM(1,1).EQ.IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2))) GOTO 70
  110. IF (IPT4.NUM(1,1).EQ.IPT3.NUM(IPT3.NUM(/1),IPT3.NUM(/2))) GOTO 70
  111. IF (IPT4.NUM(IPT4.NUM(/1),IPT4.NUM(/2)).EQ.IPT3.NUM(IPT3.NUM(/1),
  112. # IPT3.NUM(/2))) GOTO 70
  113. GOTO 71
  114. 70 CONTINUE
  115. CALL FUSELI(IPT3,IPT4,IPT5,LTELQ)
  116. SEGDES IPT3,IPT4
  117. LISREF(2)=IPT5
  118. SEGDES IPT5
  119. IPT3=IPT1.LISREF(MOD(I1 ,4)+1)
  120. IPT4=IPT2.LISREF(MOD(I2+2 ,4)+1)
  121. SEGACT IPT3,IPT4
  122. CALL FUSELI(IPT4,IPT3,IPT5,LTELQ)
  123. SEGDES IPT3,IPT4
  124. LISREF(4)=IPT5
  125. SEGDES IPT5
  126. GOTO 100
  127. 71 CONTINUE
  128. SEGDES IPT3,IPT4
  129. IPT3=IPT1.LISREF(MOD(I1+2,4)+1)
  130. IPT4=IPT2.LISREF(MOD(I2+2,4)+1)
  131. SEGACT IPT3,IPT4
  132. CALL FUSELI(IPT3,IPT4,IPT5,LTELQ)
  133. SEGDES IPT3,IPT4
  134. LISREF(2)=IPT5
  135. SEGDES IPT5
  136. IPT3=IPT1.LISREF(MOD(I1,4)+1)
  137. IPT4=IPT2.LISREF(MOD(I2,4)+1)
  138. SEGACT IPT3,IPT4
  139. CALL FUSELI(IPT3,IPT4,IPT5,LTELQ)
  140. SEGDES IPT3,IPT4
  141. LISREF(4)=IPT5
  142. SEGDES IPT5
  143. GOTO 100
  144.  
  145. 100 CONTINUE
  146. ITYPEL=IPT1.ITYPEL
  147. DO 101 I=1,NBNN
  148. DO 102 J=1,NBELE1
  149. 102 NUM(I,J)=IPT1.NUM(I,J)
  150. DO 103 J=1,NBELE2
  151. 103 NUM(I,J+NBELE1)=IPT2.NUM(I,J)
  152. 101 CONTINUE
  153. IPT3=MELEME
  154. DO 110 I=1,NBELE1
  155. ICOLOR(I)=IPT1.ICOLOR(I)
  156. 110 CONTINUE
  157. DO 120 I=1,NBELE2
  158. ICOLOR(I+NBELE1)=IPT2.ICOLOR(I)
  159. 120 CONTINUE
  160. RETURN
  161. END
  162.  
  163.  
  164.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales