Télécharger cparig.eso

Retour à la liste

Numérotation des lignes :

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

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