Télécharger cpachm.eso

Retour à la liste

Numérotation des lignes :

  1. C CPACHM SOURCE PV 17/12/05 21:15:29 9646
  2. subroutine cpachm(pChelm,seg2pi,bu,bufPos)
  3. C=======================================================================
  4. C COLlaborateur PAQuettage Champ par eleMent
  5. C Ajout du chpo pChelm dans le buffer d'envoi bu
  6. C=======================================================================
  7. integer bufPos
  8. integer lonBuf
  9. integer nbComp,iComp,nbInf
  10. integer longTit,longConch
  11. integer nNoElv,nbElv
  12. integer nNoEli,nbEli
  13. integer nbnoel,nconch
  14. integer nbCons,iCons
  15. integer ipoPi,iPoint
  16. integer sePGCD
  17. integer iNo,iEl
  18. integer nbInt,nbFloa,nbChar
  19. -INC CCOPTIO
  20. -INC SMCHAML
  21. -INC TMCOLAC
  22. segment BUFFER
  23. character ffer(lonBuf)
  24. endsegment
  25. pointeur pChelm.MCHELM
  26. pointeur pChaml.MCHAML
  27. pointeur pElval.MELVAL
  28.  
  29. pointeur bu.BUFFER
  30. pointeur seg2pi.ILISSE
  31.  
  32. C write(ioimp,*) 'Entre dans CPACHM'
  33. C write(ioimp,*)'Position du buffer',bufPos
  34. nbInt=0
  35. nbFloa=0
  36. nbChar=0
  37. if (pChelm.ne.0) then
  38. segact pChelm
  39. lonBuf=bu.ffer(/2)
  40. sePGCD=seg2pi.npgcd
  41. C write(ioimp,*)'Taille du buffer',lonBuf
  42. C Ecriture du nombre de constituant
  43. nbCons=pChelm.ichaml(/1)
  44. C write(ioimp,*)'Ecriture du nombre de constituants',nbCons
  45. call mpipaI(nbCons,1,bu,bufPos)
  46. nbInt=nbInt+1
  47. C Ecriture du nombre d info
  48. nbInf=pChelm.infche(/2)
  49. C write(ioimp,*)'Ecriture du nombre du nb d info',nbInf
  50. call mpipaI(nbInf,1,bu,bufPos)
  51. nbInt=nbInt+1
  52. longTit=pChelm.titche(/1)
  53. call mpipaI(longTit,1,bu,bufPos)
  54. nbInt=nbInt+1
  55. C write(ioimp,*)'Ecriture longueur du titre',longTit
  56. longConch=pChelm.conche(/1)
  57. call mpipaI(longConch,1,bu,bufPos)
  58. nbInt=nbInt+1
  59. C write(ioimp,*)'Ecriture longueur des noms',longConch
  60. C Ecriture du titre
  61. call mpipaC(pChelm.titche,longTit,bu,bufPos)
  62. nbChar=nbChar+longTit
  63. C write(ioimp,*) 'Ecriture du titre'
  64. C write(ioimp,*)'Position du buffer',bufPos
  65. C Ecriture du nom des consituants
  66. call mpipaC(pChelm.conche,nbCons*longConch,bu,bufPos)
  67. nbchar=nbChar+nbCons*longConch
  68. C Ecriture des maillages supports
  69. do iCons=1,nbCons
  70. C Ecriture du maillage support
  71. C write(ioimp,*) 'Maillage support'
  72. iPoint=pChelm.imache(iCons)
  73. if(iPoint.ne.0) then
  74. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  75. else
  76. iPoPi=0
  77. endif
  78. C write(ioimp,*) 'maillage et pile position',iPoint, iPopi
  79. call mpipaI(iPoPi,1,bu,bufPos)
  80. nbInt=nbInt+1
  81. enddo
  82. C Ecriture des infos
  83. call mpipaI(pChelm.infche(1,1),nbCons*3,bu,bufPos)
  84. nbInt=nbInt+nbCons*3
  85. do iCons=1,nbCons
  86. iPoint=pChelm.infche(iCons,4)
  87. if(iPoint.ne.0) then
  88. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  89. else
  90. iPoPi=0
  91. endif
  92. C write(ioimp,*) 'Pointeur vers sminte et pile',iPoint, iPopi
  93. call mpipaI(iPoPi,1,bu,bufPos)
  94. nbInt=nbInt+1
  95. enddo
  96. call mpipaI(pChelm.infche(1,5),nbCons*(nbInf-4),bu,bufPos)
  97. nbInt=nbInt+nbCons*(nbInf-4)
  98. C Ecriture de l'info de Fourrier
  99. call mpipaI(pChelm.ifoche,1,bu,bufPos)
  100. nbInt=nbInt+1
  101. C write(ioimp,*) 'Info ecrite'
  102. C write(ioimp,*)'Position du buffer',bufPos
  103. C Boucle sur les chaml elementaires
  104. do iCons=1,nbCons
  105. C write(ioimp,*) 'Chaml :',iCons
  106. pChaml=pChelm.ichaml(iCons)
  107. if(pChaml.ne.0) then
  108. segact pChaml
  109. C Ecriture du nombre de composante
  110. nbComp=pChaml.ielval(/1)
  111. C write(ioimp,*)'Ecriture du nombre de composantes',nbComp
  112. call mpipaI(nbComp,1,bu,bufPos)
  113. nbInt=nbInt+1
  114. C Ecriture du noms des composantes
  115. call mpipaC(pChaml.nomche(1),nbComp*8,bu,bufPos)
  116. nbChar=nbChar+nbComp*8
  117. C write(ioimp,*)'Position du buffer',bufPos
  118.  
  119. C Ecriture du type des composantes
  120. C write(ioimp,*)'Ecriture du type des composantes'
  121. call mpipaC(pChaml.typche(1),nbComp*16,bu,bufPos)
  122. nbChar=nbChar+nbComp*16
  123. C write(ioimp,*)'Position du buffer',bufPos
  124. do iComp=1,nbComp
  125. pElval = pChaml.ielval(iComp)
  126. C write(ioimp,*) 'pElval',pElval
  127. if(pElval.ne.0) then
  128. segact pElval
  129. C Ecriture du nombres de valeurs par composantes en
  130. C flottant
  131. nNoElv=pElval.velche(/1)
  132. nbElv=pElval.velche(/2)
  133. nNoEli=pElval.ielche(/1)
  134. nbEli =pElval.ielche(/2)
  135. call mpipaI(nNoElv,1,bu,bufPos)
  136. nbInt=nbInt+1
  137. C write(ioimp,*)'Position du buffer',bufPos
  138. call mpipaI(nbElv,1,bu,bufPos)
  139. nbInt=nbInt+1
  140. call mpipaI(nNoEli,1,bu,bufPos)
  141. nbInt=nbInt+1
  142. call mpipaI(nbEli,1,bu,bufPos)
  143. nbInt=nbInt+1
  144. C Ecriture des valeurs
  145. if(nNoElv*nbElv.ne.0) then
  146. call mpipaR(pElval.velche(1,1),nNoElv*nbElv,bu,bufPos)
  147. nbFloa=nbFloa+nNoElv*nbElv
  148. endif
  149. C Ecriture du nombres de valeurs par composantes en
  150. C flottant
  151. C Ce sont des pointeurs, il faut les convertir
  152. do iEl=1,nbEli
  153. do iNo=1,nNoEli
  154. iPoint=pElval.ielche(iNo,iEl)
  155. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  156. call mpipaI(iPoPi,1,bu,bufPos)
  157. nbInt=nbInt+1
  158. enddo
  159. enddo
  160. segdes pElval
  161. else
  162. C pElval est nul, on l'indique avec tailles nulles
  163. nbNoEl = 0
  164. call mpipaI(nbNoEl,1,bu,bufPos)
  165. nbInt=nbInt+1
  166. call mpipaI(nbNoEl,1,bu,bufPos)
  167. nbInt=nbInt+1
  168. call mpipaI(nbNoEl,1,bu,bufPos)
  169. nbInt=nbInt+1
  170. call mpipaI(nbNoEl,1,bu,bufPos)
  171. nbInt=nbInt+1
  172. endif
  173. enddo
  174. segdes pChaml
  175. else
  176. C pChaml est nul, on l'indique avec un nombre de comp nul
  177. nbComp = 0
  178. call mpipaI(nbComp,1,bu,bufPos)
  179. nbInt=nbInt+1
  180. endif
  181. enddo
  182. segdes pChelm
  183. else
  184. write(ioimp,*) 'Erreur: pointeur vers un objet CHELM nul'
  185. call erreur(5)
  186. endif
  187. C write(ioimp,*) 'Sortie de CPACHM'
  188. end
  189.  
  190.  
  191.  
  192.  
  193.  

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