Télécharger fusevo.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSEVO SOURCE BP208322 16/11/18 21:17:18 9177
  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
  44. 6 IF (KSURF(IPT4.ITYPEL).EQ.0) CALL FUSELI(IPT8,IPT4,IPT5,LTELQ)
  45. IF (KSURF(IPT4.ITYPEL).NE.0) CALL FUSESU(IPT8,IPT4,IPT5,LTELQ)
  46. SEGDES IPT8,IPT4
  47. IPT8=IPT5
  48. 5 CONTINUE
  49. 4 CONTINUE
  50. IPT6=IPT2.LISREF(3)
  51. SEGACT IPT6
  52. IF (IPT2.LISREF(/1).EQ.3) GOTO 10
  53. DO 9 I=4,IPT2.LISREF(/1)
  54. IPT4=IPT2.LISREF(I)
  55. SEGACT IPT4
  56. IF (IPT4.NUM(/2).NE.0) GOTO 8
  57. NBREF=2
  58. SEGDES IPT4
  59. GOTO 11
  60. 8 IF (KSURF(IPT4.ITYPEL).EQ.0) CALL FUSELI(IPT6,IPT4,IPT5,LTELQ)
  61. IF (KSURF(IPT4.ITYPEL).NE.0) CALL FUSESU(IPT6,IPT4,IPT5,LTELQ)
  62. SEGDES IPT6,IPT4
  63. IPT6=IPT5
  64. 9 CONTINUE
  65. 10 CONTINUE
  66. CALL OUEXCL(IPT8,IPT6,IPT7)
  67. SEGDES IPT8,IPT6,IPT7
  68. GOTO 11
  69. 1 CONTINUE
  70. C ON EST SENSE TOUT FUSIONNER A VOIR PLUS TARD
  71. NBREF=0
  72. 11 CONTINUE
  73. 100 CONTINUE
  74. C REFERENCES OK : IPT1.LISREF(1) IPT2.LISREF(2) IPT7
  75. NBNN=IPT1.NUM(/1)
  76. NBSOUS=0
  77. NBELE1=IPT1.NUM(/2)
  78. NBELE2=IPT2.NUM(/2)
  79. NBELEM=NBELE1+NBELE2
  80. SEGINI IPT3
  81. IPT3.ITYPEL=IPT1.ITYPEL
  82. IF (NBREF.EQ.0) GOTO 20
  83. IPT3.LISREF(1)=IPT1.LISREF(1)
  84. IPT3.LISREF(2)=IPT2.LISREF(2)
  85. IF (NBREF.EQ.2) GOTO 20
  86. IPT3.LISREF(3)=IPT7
  87. SEGDES IPT7
  88. 20 CONTINUE
  89. DO 21 I=1,NBNN
  90. DO 22 J=1,NBELE1
  91. IPT3.NUM(I,J)=IPT1.NUM(I,J)
  92. 22 CONTINUE
  93. DO 23 J=1,NBELE2
  94. IPT3.NUM(I,J+NBELE1)=IPT2.NUM(I,J)
  95. 23 CONTINUE
  96. 21 CONTINUE
  97. DO 25 I=1,NBELE1
  98. IPT3.ICOLOR(I)=IPT1.ICOLOR(I)
  99. 25 CONTINUE
  100. DO 27 I=1,NBELE2
  101. IPT3.ICOLOR(I+NBELE1)=IPT2.ICOLOR(I)
  102. 27 CONTINUE
  103. RETURN
  104. END
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  

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