Télécharger cpamel.eso

Retour à la liste

Numérotation des lignes :

  1. C CPAMEL SOURCE PV 16/11/26 21:15:23 9205
  2. subroutine cpamel(pMelem,lisNoe,seg2pi,bu,bufPos)
  3. C=======================================================================
  4. C COLlaborateur PAQuettage MELeme
  5. C Ajout du maillage pMeleme dans le buffer d'envoi bu
  6. C Les numeros de noeuds sont "traduit" par la
  7. C corespondance lisNoe passé en argument
  8. C=======================================================================
  9. integer nbnn, nbelem, nbsous, nbref
  10. integer bufPos
  11. integer lonBuf
  12. integer iNoCo,iNoLo
  13. integer iNoeud,jNoeud,iRef,iSous
  14. integer ipoPi,iPoint
  15. integer sePGCD
  16. -INC CCOPTIO
  17. -INC SMELEME
  18. -INC TMCOLAC
  19. segment BUFFER
  20. character ffer(lonBuf)
  21. endsegment
  22. segment LISNOD
  23. integer liste(nNoeud)
  24. endsegment
  25. pointeur pMelem.MELEME
  26. pointeur lisNoe.LISNOD
  27. pointeur bu.BUFFER
  28. pointeur seg2pi.ILISSE
  29.  
  30. C write(ioimp,*) 'Entre dans CPAMEL'
  31. if (pMelem.ne.0) then
  32. segact pMelem
  33. lonBuf=bu.ffer(/2)
  34. sePGCD=seg2pi.npgcd
  35. C write(ioimp,*)'Taille du buffer',lonBuf
  36. nbnn =pMelem.num(/1)
  37. nbelem=pMelem.num(/2)
  38. nbsous=pMelem.lisous(/1)
  39. nbref =pMelem.lisref(/1)
  40. C Ecriture du type d'element
  41. C write(ioimp,*)' Ecriture du type delement',pMelem.itypel
  42. call mpipaI(pMelem.itypel,1,bu,bufPos)
  43. C Ecriture du nombre de sous maillages
  44. C write(ioimp,*) 'Ecriture du nombre de sous maillages',nbsous
  45. call mpipaI(nbsous,1,bu,bufPos)
  46. C Ecriture du nombre de references
  47. C write(ioimp,*)'Ecriture du nombre de references',nbref
  48. call mpipaI(nbref,1,bu,bufPos)
  49. C Ecriture du nombre d'element / noeud par element
  50. C write(ioimp,*)'Ecriture du nombre d elements et noeud par element',
  51. C &nbnn,nbelem
  52. call mpipaI(nbnn,1,bu,bufPos)
  53. call mpipaI(nbelem,1,bu,bufPos)
  54. C Ecriture de la position des sous-maillages dans la pile
  55. C write(ioimp,*) 'Ecriture de la position des sous-maillages dans la
  56. C &pile'
  57. do iSous=1,nbsous
  58. C write(ioimp,*) 'Sous maillage :',iSous
  59. iPoint=pMelem.lisous(iSous)
  60. C write(ioimp,*) 'Pointeur: ',iPoint
  61. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  62. call mpipaI(iPoPi,1,bu,bufPos)
  63. enddo
  64. C Ecriture de la position des references dans la pile
  65. C write(ioimp,*)'Ecriture de la position des references dans la pile'
  66. do iRef=1,nbref
  67. C write(ioimp,*) 'Reference :',iRef
  68. iPoint=pMelem.lisref(iRef)
  69. C write(ioimp,*) 'Pointeur: ',iPoint
  70. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  71. C write(ioimp,*) 'Numeroa dans la pive: ',ipoPi
  72. call mpipaI(iPoPi,1,bu,bufPos)
  73. enddo
  74. C Ecriture de la connectivite
  75. C write(ioimp,*) 'Ecriture de la connectivite'
  76. do jNoeud=1,nbelem
  77. do iNoeud=1,nbnn
  78. C write(ioimp,*) 'element',jNoeud,'noeud',iNoeud
  79. iNoLo=pMelem.num(iNoeud,jNoeud)
  80. C write(ioimp,*) 'iNoLo',iNoLo
  81. iNoCo=lisNoe.liste(iNoLo)
  82. C write(ioimp,*) 'iNoCo',iNoCo
  83. call mpipaI(iNoCo,1,bu,bufPos)
  84. enddo
  85. enddo
  86.  
  87. C write(ioimp,*) 'Ecriture de la couleur'
  88. if(nbelem.gt.0) then
  89. call mpipaI(pMelem.icolor(1),nbelem,bu,bufPos)
  90. endif
  91. segdes pMelem
  92. else
  93. write(ioimp,*) 'Erreur: pointeur vers un objet MELEME nul'
  94. call erreur(5)
  95. endif
  96. C write(ioimp,*) 'Sortie de CPAMEL'
  97. end
  98.  
  99.  
  100.  
  101.  

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