Télécharger cparig.eso

Retour à la liste

Numérotation des lignes :

  1. C CPARIG SOURCE PV 16/11/26 21:15:26 9205
  2. subroutine cparig(pRigi,seg2pi,bu,bufPos)
  3. C=======================================================================
  4. C COLlaborateur PAQuettage RIGIdite
  5. C Ajout de la rigidite pRigi dans le buffer d'envoi bu
  6. C=======================================================================
  7. integer bufPos
  8. integer lonBuf
  9. integer ipoPi,iPoint
  10. integer sePGCD
  11. integer nrigel,nligrd,nligrp,nelrig
  12. integer jrigel
  13. integer nbInt,nbFloa,nbChar
  14. -INC CCOPTIO
  15. -INC SMRIGID
  16. -INC TMCOLAC
  17. segment BUFFER
  18. character ffer(lonBuf)
  19. endsegment
  20. pointeur bu.BUFFER
  21. pointeur seg2pi.ILISSE
  22. pointeur pRigi.MRIGID
  23. pointeur pXmatr.XMATRI
  24. pointeur pDescr.DESCR
  25.  
  26. C write(ioimp,*) 'Entre dans CPARIG'
  27. C write(ioimp,*) 'Position du buffer',bufPos
  28. nbInt=0
  29. nbFloa=0
  30. nbChar=0
  31. if (pRigi.ne.0) then
  32. segact pRigi
  33. lonBuf=bu.ffer(/2)
  34. C write(ioimp,*) 'taille du buffer',lonBuf
  35. sePGCD=seg2pi.npgcd
  36. nrigel=pRigi.coerig(/1)
  37.  
  38. C Ecriture du nombre de rigidite elementaire
  39. C write(ioimp,*) 'Nombre de rigidite elem',nrigel
  40. call mpipaI(nrigel,1,bu,bufPos)
  41. nbInt=nbInt+1
  42. C Ecriture du type
  43. C write(ioimp,*) 'Nom',pRigi.mtymat
  44. call mpipaC(pRigi.mtymat,8,bu,bufPos)
  45. nbChar=nbChar+8
  46. C Ecriture de iforig
  47. call mpipaI(pRigi.iforig,1,bu,bufPos)
  48. nbInt=nbInt+1
  49. C Ecriture de des coeff multiplicateurs
  50. C write(ioimp,*) 'Coefficiient multiplicateurs',nrigel
  51. if(nrigel.gt.0) then
  52. call mpipaR(pRigi.coerig(1),nrigel,bu,bufPos)
  53. nbFloa=nbFloa+nrigel
  54. endif
  55.  
  56. do jrigel=1,nrigel
  57. C write(ioimp,*) 'Rigidite elementaire',jRigel,nRigel
  58. iPoint=pRigi.irigel(1,jrigel)
  59. if(iPoint.gt.0) then
  60. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  61. else
  62. iPoPi=0
  63. endif
  64. C write(ioimp,*) 'Maillage 1 :',iPoint,iPopi
  65. call mpipaI(iPoPi,1,bu,bufPos)
  66. nbInt=nbInt+1
  67. iPoint=pRigi.irigel(2,jrigel)
  68. if(iPoint.gt.0) then
  69. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  70. else
  71. iPoPi=0
  72. endif
  73. C write(ioimp,*) 'Maillage 2 :',iPoint,iPopi
  74. call mpipaI(iPoPi,1,bu,bufPos)
  75. nbInt=nbInt+1
  76. call mpipaI(pRigi.irigel(5,jrigel),4,bu,bufPos)
  77. nbInt=nbInt+4
  78. enddo
  79. do jrigel=1,nrigel
  80. C write(ioimp,*) 'Rigidite elementaire',jRigel,nRigel
  81. pDescr=pRigi.irigel(3,jrigel)
  82. pXmatr=pRigi.irigel(4,jrigel)
  83. segact pDescr
  84. segact pXmatr
  85. nligrd = pXmatr.re(/1)
  86. nligrp = pXmatr.re(/2)
  87. nelrig = pXmatr.re(/3)
  88. call mpipaI(nligrd,1,bu,bufPos)
  89. nbInt=nbInt+1
  90. call mpipaI(nligrp,1,bu,bufPos)
  91. nbInt=nbInt+1
  92. call mpipaI(nelrig,1,bu,bufPos)
  93. nbInt=nbInt+1
  94.  
  95. call mpipaC(pDescr.lisinc(1),4*nligrp,bu,bufPos)
  96. nbChar=nbChar+4*nligrp
  97. call mpipaC(pDescr.lisdua(1),4*nligrd,bu,bufPos)
  98. nbChar=nbChar+4*nligrd
  99.  
  100. call mpipaI(pDescr.noelep(1),nligrp,bu,bufPos)
  101. nbInt=nbInt+nligrp
  102. call mpipaI(pDescr.noeled(1),nligrd,bu,bufPos)
  103. nbInt=nbInt+nligrd
  104.  
  105. call mpipaR(pXmatr.re(1,1,1),nligrd*nligrp*nelrig,bu,bufPos)
  106. nbFloa=nbFloa+nligrd*nligrp*nelrig
  107.  
  108. segdes pDescr
  109. segdes pXmatr
  110. enddo
  111. segdes pRigi
  112. else
  113. write(ioimp,*) 'Erreur: pointeur vers un objet RIGIDITE nul'
  114. call erreur(5)
  115. endif
  116.  
  117. C write(ioimp,*) 'nb int / float / char ecrit',NbInteger,nbFloa,nbChar
  118. C write(ioimp,*) 'Sortie de CPARIG'
  119. C write(ioimp,*) 'Position du buffer',bufPos
  120. end
  121.  
  122.  
  123.  
  124.  

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