Télécharger cpacpo.eso

Retour à la liste

Numérotation des lignes :

  1. C CPACPO SOURCE PV 17/12/05 21:15:30 9646
  2. subroutine cpacpo(pChpo,seg2pi,bu,bufPos)
  3. C=======================================================================
  4. C COLlaborateur PAQuettage CHamp par POint
  5. C Ajout du chpo pChpo dans le buffer d'envoi bu
  6. C=======================================================================
  7. integer bufPos
  8. integer lonBuf
  9. integer nat,nbComp,nbNoeu,nSoupo
  10. integer iSoupo
  11. integer ipoPi,iPoint
  12. integer sePGCD
  13. C CHARACTER*72 SOUTYP
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMCHPOI
  18. -INC TMCOLAC
  19. segment BUFFER
  20. character ffer(lonBuf)
  21. endsegment
  22. pointeur pChpo.MCHPOI
  23. pointeur pSoupo.MSOUPO
  24. pointeur pPoval.MPOVAL
  25. pointeur bu.BUFFER
  26. pointeur seg2pi.ILISSE
  27.  
  28. C write(ioimp,*) 'Entre dans CPACPO'
  29. C write(ioimp,*)'Position du buffer',bufPos
  30. if (pChpo.ne.0) then
  31. segact pChpo
  32. C SOUTYP=pChpo.MTYPOI
  33. lonBuf=bu.ffer(/2)
  34. sePGCD=seg2pi.npgcd
  35. C write(ioimp,*)'Taille du buffer',lonBuf
  36. nat =pChpo.jattri(/1)
  37. C Ecriture du type
  38. C write(ioimp,*)' Ecriture du type'
  39. call mpipaC(pChpo.mtypoi,8,bu,bufPos)
  40. C write(ioimp,*)'Position du buffer',bufPos
  41. C SOUTYP=pChpo.mochde
  42. C Ecriture de la description
  43. C write(ioimp,*) 'Ecriture de la description'
  44. call mpipaC(pChpo.mochde,72,bu,bufPos)
  45. C write(ioimp,*)'Position du buffer',bufPos
  46. C Ecriture sur fourrier
  47. C write(ioimp,*)'Ecriture de IFOPOI',pChpo.ifopoi
  48. call mpipaI(pChpo.ifopoi,1,bu,bufPos)
  49. C write(ioimp,*)'Position du buffer',bufPos
  50. C Ecriture des sous po
  51. nSoupo=pChpo.ipchp(/1)
  52. C Ecriture du nombre de soupo
  53. C write(ioimp,*)'Ecriture du nombre de soupo',nSoupo
  54. call mpipaI(nSoupo,1,bu,bufPos)
  55. C write(ioimp,*)'Position du buffer',bufPos
  56. C Ecriture du nombre de nature
  57. C write(ioimp,*)'Ecriture du nombre de nature',nat
  58. call mpipaI(nat,1,bu,bufPos)
  59. C Ecriture de la nature
  60. c write(ioimp,*)'Ecriture de la nature'
  61. if(nat.gt.0) then
  62. call mpipaI(pChpo.jattri(1),nat,bu,bufPos)
  63. endif
  64. do iSoupo=1,nSoupo
  65. C write(ioimp,*) 'Soupo :',iSoupo
  66. pSoupo=pChpo.ipchp(iSoupo)
  67. if(pSoupo.ne.0) then
  68. segact pSoupo
  69. C Ecriture du nombre de composantes
  70. nbComp = pSoupo.noharm(/1)
  71. pPoval = pSoupo.ipoval
  72. if(pPoval.ne.0) then
  73. segact pPoval
  74. nbNoeu = pPoval.vpocha(/1)
  75. else
  76. nbNoeu = 0
  77. endif
  78. C write(ioimp,*)'Ecriture du nombre de composantes',nbComp
  79. call mpipaI(nbComp,1,bu,bufPos)
  80. C write(ioimp,*)'Ecriture du nombre de noeud',nbNoeu
  81. call mpipaI(nbNoeu,1,bu,bufPos)
  82. if(nbNoeu.gt.0.and.nbComp.gt.0) then
  83. C Ecriture des valeurs
  84. C write(ioimp,*)'Ecriture des valeurs'
  85. call mpipaR(pPoval.vpocha(1,1),nbNoeu*nbComp,bu,bufPos)
  86. segdes pPoval
  87. endif
  88. C Ecriture du maillage support
  89. C write(ioimp,*) 'Maillage support'
  90. iPoint=pSoupo.igeoc
  91. if(iPoint.ne.0) then
  92. iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
  93. else
  94. iPoPi = 0
  95. endif
  96. C write(ioimp,*) 'Pointeur vers maillage et position dans la
  97. C & pile',iPoint, iPopi
  98. call mpipaI(iPoPi,1,bu,bufPos)
  99. C Ecriture des noms des composantes
  100. C write(ioimp,*)'Ecriture du nom des composantes'
  101. if(nbComp.gt.0) then
  102. call mpipaC(pSoupo.nocomp(1),nbComp*4,bu,bufPos)
  103. C SOUTYP=pSoupo.nocomp(1)
  104. C write(ioimp,*) 'Nom composante',soutyp
  105. C write(ioimp,*)'Position du buffer',bufPos
  106.  
  107. C Ecriture des noms des constituants
  108. C write(ioimp,*)'Ecriture du nom des constituants'
  109. call mpipaC(pSoupo.nocons(1), nbComp*16,bu,bufPos)
  110. C SOUTYP=pSoupo.nocons(1)
  111. C write(ioimp,*) 'Nom constituant',soutyp
  112. C write(ioimp,*)'Position du buffer',bufPos
  113. C Ecriture du numero des harmoniques
  114. C write(ioimp,*)'Ecriture du numero des harmoniques',
  115. C & (pSoupo.noharm(i),i=1,nbComp)
  116. call mpipaI(pSoupo.noharm(1),nbComp,bu,bufPos)
  117. C write(ioimp,*)'Position du buffer',bufPos
  118. endif
  119. segdes pSoupo
  120. else
  121. C pSoupo est nul, on l'indique avec un nombre de comp nul
  122. C ainsi qu'un pointeur vers un maillage nul et un nb de
  123. C noeud nul
  124. nbComp = 0
  125. C write(ioimp,*)'Ecriture du nombre de composantes',nbComp
  126. call mpipaI(nbComp,1,bu,bufPos)
  127. call mpipaI(nbComp,1,bu,bufPos)
  128. call mpipaI(nbComp,1,bu,bufPos)
  129. endif
  130. enddo
  131. segdes pChpo
  132. else
  133. write(ioimp,*) 'Erreur: pointeur vers un objet CHPO nul'
  134. call erreur(5)
  135. endif
  136. C write(ioimp,*) 'Sortie de CPACPO'
  137. end
  138.  
  139.  
  140.  
  141.  
  142.  

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