Télécharger cupcpo.eso

Retour à la liste

Numérotation des lignes :

  1. C CUPCPO SOURCE PV 17/12/05 21:15:45 9646
  2. subroutine cupcpo(bu,bufPos,pChpo)
  3. C=======================================================================
  4. C COLlaborateur UnPAQuettage Champ par POint
  5. C Lecture d'un champ par point dans le buffer d'envoi bu
  6. C=======================================================================
  7. integer bufPos
  8. integer lonBuf
  9. integer nat,nbComp,nbNoeu,nSoupo,n,nc
  10. integer iSoupo,mofour
  11. character*8 typChp
  12. character*72 desChp
  13. C character*72 soutyp
  14. -INC SMCHPOI
  15. -INC TMCOLAC
  16. segment BUFFER
  17. character ffer(lonBuf)
  18. endsegment
  19.  
  20. pointeur pChpo.MCHPOI
  21. pointeur pSoupo.MSOUPO
  22. pointeur pPoval.MPOVAL
  23. pointeur bu.BUFFER
  24.  
  25. C write(ioimp,*) 'Entre dans CUPCPO'
  26. C write(ioimp,*)'Position du buffer',bufPos
  27. lonBuf=bu.ffer(/2)
  28. C write(ioimp,*)'Taille du buffer',lonBuf
  29. call mpiupC(typChp,8, bu,bufPos)
  30.  
  31. C write(ioimp,*)'Type du champ',typChp
  32. C write(ioimp,*)'Position du buffer',bufPos
  33. call mpiupC(desChp,72, bu,bufPos)
  34.  
  35. C write(ioimp,*)'Description du champ',desChp
  36. C write(ioimp,*)'Position du buffer',bufPos
  37. call mpiupI(mofour,1, bu,bufPos)
  38.  
  39. C write(ioimp,*)'Ifopoi',mofour
  40. C write(ioimp,*)'Position du buffer',bufPos
  41. call mpiupI(nSoupo,1, bu,bufPos)
  42.  
  43. C write(ioimp,*)'nsoupo',nsoupo
  44. C write(ioimp,*)'Position du buffer',bufPos
  45. call mpiupI(nat,1, bu,bufPos)
  46.  
  47. C write(ioimp,*) 'Buff', bufPos,lonBuf
  48. C write(ioimp,*)'nat',nat
  49. if (pChpo.ne.0) then
  50. segact pChpo*mod
  51. segadj pChpo
  52. else
  53. segini pChpo
  54. endif
  55. pChpo.MTYPOI=typChp
  56. pChpo.MOCHDE=desChp
  57. pChpo.IFOPOI=mofour
  58.  
  59. if(nat.gt.0) then
  60. call mpiupI(pChpo.jattri(1), nat, bu,bufPos)
  61. endif
  62. C write(ioimp,*)'jattri',(pChpo.jattri(i),i=1,nat)
  63. do iSoupo=1,nSoupo
  64. C write(ioimp,*) 'Soupo :',iSoupo
  65. call mpiupI(nbComp,1, bu,bufPos)
  66.  
  67. C write(ioimp,*)'nbComp',nbComp
  68. call mpiupI(nbNoeu,1, bu,bufPos)
  69.  
  70. C write(ioimp,*)'nbNoeu',nbNoeu
  71. nc=nbComp
  72. segini pSoupo
  73. pChpo.ipchp(iSoupo)=pSoupo
  74. n=nbNoeu
  75. segini pPoval
  76. pSoupo.ipoval=pPoval
  77. if(nbNoeu.gt.0.and.nbComp.gt.0) then
  78. C write(ioimp,*)'Lecture des valeurs'
  79. call mpiupR( pPoval.vpocha(1,1),nbNoeu*nbComp, bu,bufPos)
  80.  
  81. endif
  82. segdes pPoval
  83. C write(ioimp,*) 'iSoupo',iSoupo
  84. C write(ioimp,*) 'pSoupo',pSoupo
  85. call mpiupI( pSoupo.igeoc,1, bu,bufPos)
  86.  
  87. C write(ioimp,*)'pSoupo.igeoc',pSoupo.igeoc
  88. if(nbComp.gt.0)then
  89. call mpiupC( pSoupo.nocomp(1),nbComp*4, bu,bufPos)
  90.  
  91. C write(ioimp,*)'Lecture du nom de composante'
  92. C SOUTYP=pSoupo.nocomp(1)
  93. C write(ioimp,*) 'Nom composante',soutyp
  94. C write(ioimp,*)'Position du buffer',bufPos
  95. call mpiupC( pSoupo.nocons(1),nbComp*16, bu,bufPos)
  96.  
  97. C write(ioimp,*)'Lecture du nom de constituants'
  98. C SOUTYP=pSoupo.nocons(1)
  99. C write(ioimp,*) 'Nom constituant',soutyp
  100. C write(ioimp,*)'Position du buffer',bufPos
  101. call mpiupI( pSoupo.noharm(1),nbComp, bu,bufPos)
  102.  
  103. C write(ioimp,*)'Lecture du numero des harmoniques',
  104. C & (pSoupo.noharm(i),i=1,nbComp)
  105. C write(ioimp,*)'Position du buffer',bufPos
  106. endif
  107. segdes pSoupo
  108. enddo
  109. segdes pChpo
  110. C write(ioimp,*) 'Sortie de CUPCPO'
  111. end
  112.  
  113.  
  114.  
  115.  
  116.  

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