Télécharger cupchm.eso

Retour à la liste

Numérotation des lignes :

  1. C CUPCHM SOURCE GF238795 15/04/23 21:15:40 8502
  2. subroutine cupchm(bu,bufPos,pChelm)
  3. C=======================================================================
  4. C COLlaborateur UnPAQuettage Champ par eleMent
  5. C Recuperation d'un champ par element dans le buffer bu
  6. C=======================================================================
  7. integer bufPos
  8. integer lonBuf
  9. integer nbComp,iComp,nbInf
  10. integer longTit,longConch
  11. integer nbCons,iCons,nconch
  12. integer n1,n2,n3,l1,n1ptel,n1el,n2ptel,n2el
  13.  
  14. -INC SMCHAML
  15. segment BUFFER
  16. character ffer(lonBuf)
  17. endsegment
  18. pointeur pChelm.MCHELM
  19. pointeur pChaml.MCHAML
  20. pointeur pElval.MELVAL
  21. pointeur bu.BUFFER
  22.  
  23. C write(ioimp,*) 'Entre dans CUPCHM'
  24. lonBuf=bu.ffer(/2)
  25. call mpiupI(nbCons,1, bu,bufPos)
  26. C write(ioimp,*)'Nombre de constituants',nbCons
  27. call mpiupI(nbInf,1, bu,bufPos)
  28. C write(ioimp,*)'Nombre d infos',nbInf
  29. call mpiupI(longTit,1, bu,bufPos)
  30. C write(ioimp,*)'Longueur titre',longTit
  31. call mpiupI(longConch,1, bu,bufPos)
  32. C write(ioimp,*)'Longueur nom constituant',longConch
  33.  
  34. l1=longtit
  35. if(nconch.ne.longConch) then
  36. write(ioimp,*) 'Taille de chaine de caracterer incoherente'
  37. call erreur(5)
  38. endif
  39. n1=nbcons
  40. n3=nbinf
  41. if (pChelm.ne.0) then
  42. segact pChelm*mod
  43. segadj pChelm
  44. else
  45. segini pChelm
  46. endif
  47. C Lecture du titre
  48. call mpiupC( pChelm.titche,longTit , bu,bufPos)
  49. C write(ioimp,*)'Lecture du titre'
  50. C write(ioimp,*)'Position du buffer',bufPos
  51. C Lecture du nom des constituants
  52. call mpiupC( pChelm.conche,nbCons*longConch , bu,bufPos)
  53. C write(ioimp,*)'Lecture des noms'
  54. call mpiupI( pChelm.imache,nbCons, bu,bufPos)
  55. C write(ioimp,*)'Lecture des maillages',pChelm.imache(1)
  56. call mpiupI( pChelm.infche(1,1),nbCons*nbInf, bu,bufPos)
  57. C write(ioimp,*)'Lecture des infos'
  58. call mpiupI( pChelm.ifoche,1, bu,bufPos)
  59. C write(ioimp,*)'Lecture de ifoche',pChelm.ifoche
  60. C write(ioimp,*)'Position du buffer',bufPos
  61.  
  62. do iCons=1,nbCons
  63. C write(ioimp,*) 'Constituant :',iCons
  64. call mpiupI(nbComp,1, bu,bufPos)
  65. C write(ioimp,*)'nbComp',nbComp
  66. n2=nbComp
  67. segini pChaml
  68. C write(ioimp,*) 'pChaml',pChaml
  69. pChelm.ichaml(iCons)=pChaml
  70. if(nbComp.gt.0)then
  71. call mpiupC( pChaml.nomche(1),nbComp*8, bu,bufPos)
  72. C write(ioimp,*)'Lecture du nom de composante'
  73. C write(ioimp,*)'Position du buffer',bufPos
  74. call mpiupC( pChaml.typche(1),nbComp*16, bu,bufPos)
  75. C write(ioimp,*)'Lecture du type de composante'
  76. C write(ioimp,*)'Position du buffer',bufPos
  77. do iComp=1,nbComp
  78. call mpiupI(n1ptel,1, bu,bufPos)
  79. call mpiupI(n1el,1, bu,bufPos)
  80. call mpiupi(n2ptel,1, bu,bufPos)
  81. call mpiupI(n2el,1, bu,bufPos)
  82. C write(ioimp,*)'Nombre de choses',n1ptel,n1el,n2ptel,n2el
  83. segini pElval
  84. C write(ioimp,*) 'pElval alloue',pElval
  85. pChaml.iElval(iComp)=pElval
  86.  
  87. if(n1ptel*n1el.ne.0) then
  88. call mpiupR(pElval.velche(1,1),n1ptel*n1el, bu,bufPos)
  89. endif
  90. if(n2ptel*n2el.ne.0) then
  91. call mpiupI( pElval.ielche(1,1),n2ptel*n2el, bu,bufPos)
  92. endif
  93. segdes pElval
  94. enddo
  95. endif
  96. segdes pChaml
  97. enddo
  98. segdes pChelm
  99. C write(ioimp,*) 'Sortie de CUPCHM'
  100. end
  101.  
  102.  
  103.  

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