Télécharger fusebo.eso

Retour à la liste

Numérotation des lignes :

  1. C FUSEBO SOURCE BP208322 16/11/18 21:17:17 9177
  2.  
  3. C CE SOUS-PROGRAMME L'OPERATION "ET" SUR UN maillage pas beau
  4. C ( qui ne respecte pas la partition par type)pour le rendre beau.
  5. C On ne s'occupe pas des references
  6. C IPT1: en entree IPT3: en sortie
  7. C
  8. SUBROUTINE FUSEBO(IPT1,IPT3)
  9. IMPLICIT INTEGER(I-N)
  10. -INC CCOPTIO
  11. -INC CCGEOME
  12. -INC SMELEME
  13. SEGMENT ISO1(NBSOU1)
  14. SEGMENT ISO2(NBSOU1)
  15. segment iso3(nbsou1)
  16. SEGACT IPT1
  17. NBSOU1= IPT1.LISOUS(/1)
  18. * write(6,*) ' entree dans fusebo nbsou1 ' , nbsou1
  19. segact ipt1
  20. SEGINI ISO1,ISO2,iso3
  21. DO 350 I=1,NBSOU1
  22. 350 ISO1(I)=IPT1.LISOUS(I)
  23. SEGDES IPT1
  24. ity=0
  25. nbref=0
  26. nbsous=0
  27. DO 310 I1=1,NBSOU1
  28. IPT1=ISO1(I1)
  29. if(IPT1.EQ.0) go to 310
  30. ity = 1 + ity
  31. ias = 1
  32. iso3(ias)=ipt1
  33. segact ipt1
  34. nbnn = ipt1.num(/1)
  35. nbelem = ipt1.num(/2)
  36. do 330 i2 = i1+1, nbsou1
  37. IPT2=ISO1(I2)
  38. IF (IPT2.EQ.0) GOTO 330
  39. IPT2=ISO1(I2)
  40. IF (IPT2.EQ.0) GOTO 330
  41. SEGACT IPT2
  42. IF (IPT1.ITYPEL.NE.IPT2.ITYPEL) GOTO 340
  43. IF (IPT1.NUM(/1).NE.IPT2.NUM(/1)) GOTO 340
  44. ias = ias+1
  45. iso3(ias)= ipt2
  46. iso1(i2)=0
  47. nbelem = nbelem + ipt2.num(/2)
  48. 340 continue
  49. if(ipt1.ne.ipt2) segdes ipt2
  50. 330 continue
  51. if(ias.eq.1) then
  52. iso2(ity) = ipt1
  53. segdes ipt1
  54. else
  55. segini meleme
  56. idec=0
  57. itypel = ipt1.itypel
  58. DO 311 I2=1,ias
  59. IPT1=ISO3(I2)
  60. segact ipt1
  61. do 351 nbe=1,ipt1.num(/2)
  62. do 352 nbn=1,nbnn
  63. num(nbn,idec+nbe)=ipt1.num(nbn,nbe)
  64. 352 continue
  65. 351 continue
  66. do 353 nbe=1,ipt1.num(/2)
  67. 353 icolor(idec+nbe)=ipt1.icolor(nbe)
  68. idec = idec + ipt1.num(/2)
  69. segdes ipt1
  70. 311 continue
  71. iso2(ity)=meleme
  72. SEGDES meleme
  73. endif
  74. 310 CONTINUE
  75. if( ity.eq.1) then
  76. ipt3 = iso2(1)
  77. else
  78. NBREF=0
  79. NBNN=0
  80. NBELEM=0
  81. nbsous = ity
  82. SEGINI IPT3
  83. DO 111 I=1,NBSOUs
  84. IPT3.LISOUS(I)=ISO2(I)
  85. 111 CONTINUE
  86. endif
  87. SEGSUP ISO1,ISO2,iso3
  88. 1020 SEGDES IPT3
  89. segdes ipt3
  90. RETURN
  91. END
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  
  105.  

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