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

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