Télécharger medtra.eso

Retour à la liste

Numérotation des lignes :

  1. C MEDTRA SOURCE BP208322 16/11/18 21:19:09 9177
  2. subroutine medtra(meleme,icle)
  3. implicit real*8(a-h,o-z)
  4. implicit integer (i-n)
  5.  
  6.  
  7. C icle=1 passage de la numerotation Cast3M à MED
  8. C icle=2 passage de la numerotation MED à Cast3M
  9. C Suppression du segment meleme puis création d'un nouveau
  10.  
  11.  
  12. -INC CCOPTIO
  13. -INC SMELEME
  14. -INC CCGEOME
  15.  
  16. C Définition du tableau des permutations
  17. dimension iper(80)
  18. data iper/3,5,2,4,6 ,3,5,7,2,4,6,8,
  19. & 3,5,7,13,15,17,19,2,4,6,8,14,16,18,20,9,10,11,12,
  20. & 3,5,10,12,14,2,4,6,11,13,15,7,8,9,
  21. & 3,5,10,2,4,6,7,8,9,
  22. & 3,5,2,4,6,7, 3,5,7,2,4,6,8,9,
  23. & 3,5,7,13,2,4,6,8,9,10,11,12/
  24.  
  25. C Cas des éléments de degré différent de 3
  26. if(kdegre(itypel).ne.3) return
  27.  
  28. ipo=-1
  29.  
  30. if(itypel.eq.6) then
  31. C Cas des TRI6
  32. ipo=0
  33. elseif(itypel.eq.10) then
  34. C Cas des QUA8
  35. ipo=5
  36. elseif(itypel.eq.15) then
  37. C Cas des CU20
  38. ipo=12
  39. elseif(itypel.eq.17) then
  40. C Cas des PR15
  41. ipo=31
  42. elseif(itypel.eq.24) then
  43. C Cas des TE10
  44. ipo=45
  45. elseif(itypel.eq.7) then
  46. C Cas des TRI7
  47. ipo=54
  48. elseif(itypel.eq.11) then
  49. C Cas des QUA9
  50. ipo=60
  51. elseif(itypel.eq.26) then
  52. C Cas des PY13
  53. ipo=68
  54. endif
  55.  
  56. C Certains éléments n'ont pas besoin de modification de connectivité
  57. if(ipo.eq.-1) return
  58.  
  59. C Copie du meleme dans ipt1
  60. segini,ipt1=meleme
  61.  
  62. nn= meleme.num(/1)
  63. ia= meleme.itypel
  64.  
  65. if(icle.eq.1) then
  66. do ib=1,meleme.num(/2)
  67. do ia = 1,nn-1
  68. ipt1.num(ia+1,ib)=meleme.num(iper(ipo+ia),ib)
  69. enddo
  70. enddo
  71. segdes meleme
  72. meleme=ipt1
  73.  
  74. elseif(icle.eq.2) then
  75. do ib=1,meleme.num(/2)
  76. do ia = 1,nn-1
  77. ipt1.num(iper(ipo+ia),ib)=meleme.num(ia+1,ib)
  78. enddo
  79. enddo
  80. segsup meleme
  81. meleme=ipt1
  82. endif
  83.  
  84. return
  85. end
  86.  
  87.  
  88.  
  89.  
  90.  

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