Télécharger cpacpo.eso

Retour à la liste

Numérotation des lignes :

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

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