Télécharger impp1.eso

Retour à la liste

Numérotation des lignes :

  1. C IMPP1 SOURCE CHAT 05/01/13 00:34:19 5004
  2. SUBROUTINE IMPP1(IPT3,IPT2)
  3. *
  4. * création du maillage support des conditions aux limites de changement
  5. * de phase: création en vue d'un bloquer mini ou d'un bloque maxi.
  6. * C'est a dire que pour chaque point on cree un multiplicateurs
  7. * les elements crees sont de type 22
  8. IMPLICIT INTEGER(I-N)
  9. -INC CCOPTIO
  10. -INC SMELEME
  11. -INC SMCOORD
  12. segment icpr(XCOOR(/1)/(IDIM+1))
  13. segini icpr
  14. meleme=ipt3
  15. segact meleme
  16. ipt1 = meleme
  17. do 1 I=1,max(1,ipt1.lisous(/1))
  18. if(ipt1.lisous(/1). NE. 0) then
  19. meleme = lisous(i)
  20. segact meleme
  21. endif
  22. do 2 J=1,NUM(/2)
  23. do 2 K = 1, num(/1)
  24. icpr(num(K,J))=1
  25. 2 continue
  26. IF(ipt1.lisous(/1). NE. 0) segdes meleme
  27. 1 continue
  28. segdes ipt1
  29. na=0
  30. do 3 j=1,icpr(/1)
  31. if(icpr(J).ne.0) then
  32. na = na + 1
  33. icpr(j) = na
  34. endif
  35. 3 continue
  36. idim1 = idim +1
  37. nbelem = na
  38. nbnn = 2
  39. nbsous=0
  40. nbref=0
  41. segini meleme
  42. itypel=22
  43. ndec = xcoor(/1)/(IDIM+1)
  44. nbpts = ndec + na
  45. segadj mcoord
  46. nb = na
  47. na=0
  48. do 4 i=1,icpr(/1)
  49. if(icpr(i).ne.0) then
  50. na = na + 1
  51. nc = na + ndec
  52. ncidi=(nc - 1 ) * idim1 +1
  53. num(1,na) = nc
  54. num(2,na) = i
  55. i1 = ( icpr(i) - 1) * idim1 +1
  56. xcoor(ncidi) = xcoor ( i1)
  57. xcoor(ncidi+1) = xcoor( i1 + 1)
  58. if (idim.eq.3) xcoor(ncidi+2) = xcoor( i1 + 2)
  59. endif
  60. 4 continue
  61. segdes meleme
  62. ipt2=meleme
  63. segsup icpr
  64. return
  65. end
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  

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