Télécharger cpamod.eso

Retour à la liste

Numérotation des lignes :

cpamod
  1. C CPAMOD SOURCE OF166741 23/06/19 21:15:03 11680
  2. subroutine cpamod(pModel,lisNoe,seg2pi,bu,bufPos)
  3. C=======================================================================
  4. C COLlaborateur PAQuettage MODele
  5. C Ajout du model pModel dans le buffer d'envoi bu
  6. C Les numeros de noeuds sont "traduit" par la
  7. C corespondance lisNoe passe en argument
  8. C=======================================================================
  9. integer mn3,nlconmo,nfor,nmat,ntyp,nObMod,nbrobl,nbrfac,n1
  10. integer iMod,iInfo,iNomid,iObMod
  11. integer bufPos
  12. integer lonBuf
  13. integer ipoPi,iPoint
  14. integer iNoCo,iNoLo
  15. integer iObl,iFac
  16. integer sePGCD
  17. integer nbInt,nbChar
  18. integer lconmo
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMMODEL
  23. -INC TMCOLAC
  24. segment BUFFER
  25. character ffer(lonBuf)
  26. endsegment
  27. C La liste de noeud est necessaire pour le noeud de deformation plane
  28. C generealisee
  29. segment LISNOD
  30. integer liste(nNoeud)
  31. endsegment
  32. pointeur pNomid.NOMID
  33. pointeur pModel.MMODEL
  34. pointeur modele.IMODEL
  35. pointeur lisNoe.LISNOD
  36. pointeur bu.BUFFER
  37. pointeur seg2pi.ILISSE
  38.  
  39. C write(ioimp,*) 'Entre dans CPAMOD'
  40. C write(ioimp,*) 'Position du buffer',bufPos
  41. if (pModel.ne.0) then
  42. write(ioimp,*) 'Erreur: pointeur vers un objet MODELE nul'
  43. call erreur(5)
  44. return
  45. endif
  46.  
  47. nbInt=0
  48. nbChar=0
  49. segact pModel
  50. lonBuf=bu.ffer(/2)
  51. C write(ioimp,*) 'taille du buffer',lonBuf
  52. sePGCD=seg2pi.npgcd
  53. n1 = pModel.kmodel(/1)
  54. call mpipaI(n1,1,bu,bufPos)
  55. nbInt=nbInt+1
  56. C write(ioimp,*) 'Nombre de modele elem',n1
  57. do iMod=1,n1
  58. modele=pModel.kmodel(iMod)
  59. C Pointeur invalide
  60. if (modele.le.0) then
  61. C write(ioimp,*) 'Pointeur invalide vers le imodel'
  62. call erreur(5)
  63. endif
  64. segact modele
  65. mn3=modele.infmod(/1)
  66. nlconmo=modele.conmod(/1)
  67. nfor = modele.formod(/2)
  68. nmat = modele.matmod(/2)
  69. ntyp = modele.lnomid(/1)
  70. nObMod=modele.ivamod(/1)
  71. C write(ioimp,*) 'Taille du modele',mn3, nlconmo, nfor,nmat,nObMod
  72. C write(ioimp,*) 'Position du buffer',bufPos
  73. call mpipaI(mn3,1,bu,bufPos)
  74. nbInt=nbInt+1
  75. C write(ioimp,*) 'Position du buffer',bufPos
  76. call mpipaI(nlconmo,1,bu,bufPos)
  77. nbInt=nbInt+1
  78. C write(ioimp,*) 'Position du buffer',bufPos
  79. call mpipaI(nfor,1,bu,bufPos)
  80. nbInt=nbInt+1
  81. C write(ioimp,*) 'Position du buffer',bufPos
  82. call mpipaI(nmat,1,bu,bufPos)
  83. nbInt=nbInt+1
  84. C write(ioimp,*) 'Position du buffer',bufPos
  85. call mpipaI(ntyp,1,bu,bufPos)
  86. nbInt=nbInt+1
  87. C write(ioimp,*) 'Position du buffer',bufPos
  88. call mpipaI(nObMod,1,bu,bufPos)
  89. nbInt=nbInt+1
  90. C write(ioimp,*) 'Position du buffer',bufPos
  91. iPoint=modele.imamod
  92. C write(ioimp,*) 'Pointeur: ',iPoint
  93. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  94. C write(ioimp,*) 'Numero dans la pile: ',ipoPi
  95. call mpipaI(iPoPi,1,bu,bufPos)
  96. nbInt=nbInt+1
  97. call mpipaI(modele.nefmod,1,bu,bufPos)
  98. nbInt=nbInt+1
  99. call mpipaI(modele.infmod(1),1,bu,bufPos)
  100. nbInt=nbInt+1
  101. do iInfo=2,mn3
  102. C write(ioimp,*) 'Info',iInfo,'sur',mn3
  103. iPoint=modele.infmod(iInfo)
  104. if(iPoint.gt.0) then
  105. C write(ioimp,*) 'Pointeur info: ',iPoint
  106. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  107. else
  108. C write(ioimp,*) 'Attention, pointeur nul dans le
  109. C& modele',pModel
  110. iPoPi=iPoint
  111. endif
  112. C write(ioimp,*) 'Numero dans la pile: ',ipoPi
  113. call mpipaI(iPoPi,1,bu,bufPos)
  114. nbInt=nbInt+1
  115. enddo
  116. call mpipaC(modele.conmod,nlconmo,bu,bufPos)
  117. nbChar=nbChar+nlconmo
  118. call mpipaC(modele.cmatee,8,bu,bufPos)
  119. nbChar=nbChar+8
  120. call mpipaC(modele.formod,16*nfor,bu,bufPos)
  121. nbChar=nbChar+16*nmat
  122. call mpipaC(modele.matmod,16*nmat,bu,bufPos)
  123. nbChar=nbChar+16
  124. C write(ioimp,*) 'Info sur le modele'
  125. C write(ioimp,*) 'Position du buffer',bufPos
  126. iNoLo=modele.ipdpge
  127. C write(ioimp,*) 'iNoLo',iNoLo
  128. if(iNoLo.gt.0) then
  129. iNoCo= seg2pi.iliseg((iNolo-1)/sePGCD)
  130. else
  131. iNoCo=0
  132. endif
  133. C write(ioimp,*) 'iNoCo',iNoCo
  134. call mpipaI(iNoCo,1,bu,bufPos)
  135. nbInt=nbInt+1
  136. C write(ioimp,*) 'Position du buffer',bufPos
  137. call mpipaI(modele.iMatee,1,bu,bufPos)
  138. nbInt=nbInt+1
  139. C write(ioimp,*) 'Position du buffer',bufPos
  140. call mpipaI(modele.iNatuu,1,bu,bufPos)
  141. nbInt=nbInt+1
  142. C write(ioimp,*) 'Position du buffer',bufPos
  143. call mpipaI(modele.iDeriv,1,bu,bufPos)
  144. nbInt=nbInt+1
  145. C write(ioimp,*) 'Numero de modele'
  146. C write(ioimp,*) 'Position du buffer',bufPos
  147. do iNomid=1,ntyp
  148. pNomid=modele.lnomid(iNomid)
  149. C write(ioimp,*) 'nomid',iNomid,'sur',ntyp
  150. if(pNomid.ne.0) then
  151. segact pNomid
  152. nbrobl=pNomid.lesobl(/2)
  153. nbrfac=pNomid.lesfac(/2)
  154. call mpipaI(nbrobl,1,bu,bufPos)
  155. nbInt=nbInt+1
  156. C write(ioimp,*) 'Position du buffer',bufPos
  157. call mpipaI(nbrfac,1,bu,bufPos)
  158. nbInt=nbInt+1
  159. C write(ioimp,*) 'Position du buffer',bufPos
  160. call mpipaC(pNomid.lesobl,8*nbrobl,bu,bufPos)
  161. nbChar=nbChar+8*nbrobl
  162. C write(ioimp,*) 'Position du buffer',bufPos
  163. call mpipaC(pNomid.lesfac,8*nbrfac,bu,bufPos)
  164. nbChar=nbChar+8*nbrfac
  165. C write(ioimp,*) 'Enregistrement du nomid'
  166. C write(ioimp,*) 'Position du buffer',bufPos
  167. C do iObl=1,nbrobl
  168. C write(ioimp,*) 'Obl',iObl,'/',nbrobl,pNomid.lesobl(iObl)
  169. C enddo
  170. C do iFac=1,nbrFac
  171. C write(ioimp,*) 'Fac',iFac,'/',nbrFac,pNomid.lesFac(iFac)
  172. C enddo
  173. segdes pNomid
  174. else
  175. C write(ioimp,*) 'Pointeur vers segment nomid invalide'
  176. nbrobl=0
  177. nbrfac=0
  178. call mpipaI(nbrobl,1,bu,bufPos)
  179. nbInt=nbInt+1
  180. C write(ioimp,*) 'Position du buffer',bufPos
  181. call mpipaI(nbrfac,1,bu,bufPos)
  182. nbInt=nbInt+1
  183. C write(ioimp,*) 'Position du buffer',bufPos
  184. endif
  185. enddo
  186. C write(ioimp,*) 'Nomids envoye'
  187. C write(ioimp,*) 'Position du buffer',bufPos
  188. call mpipaI(modele.infele,16,bu,bufPos)
  189. nbInt=nbInt+16
  190. C write(ioimp,*) 'Infele envoye'
  191. C write(ioimp,*) 'Position du buffer',bufPos
  192. C write(ioimp,*) 'Nombre d objets',nObMod
  193. call mpipaC(modele.tymode,8*nObMod,bu,bufPos)
  194. nbChar=nbChar+8*nObMod
  195. do iObMod=1,nObMod
  196. iPoint=modele.iVaMod(iObMod)
  197. C write(ioimp,*) 'Pointeur: ',iPoint
  198. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  199. C write(ioimp,*) 'Numero dans la pile: ',ipoPi
  200. call mpipaI(iPoPi,1,bu,bufPos)
  201. nbInt=nbInt+1
  202. enddo
  203. segdes modele
  204. enddo
  205. segdes pModel
  206.  
  207. C write(ioimp,*) 'Sortie de CPAMOD'
  208. C write(ioimp,*) 'Position du buffer',bufPos
  209. C write(ioimp,*) 'Nb ecrit : entier char',nbInt,nbChar
  210. c return
  211. end
  212.  
  213.  
  214.  

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