Télécharger cupmod.eso

Retour à la liste

Numérotation des lignes :

  1. C CUPMOD SOURCE GF238795 15/04/23 21:15:44 8502
  2. subroutine cupmod(bu,bufPos,pModel)
  3. C=======================================================================
  4. C COLlaborateur UnPAQuettage MODele
  5. C Lecture d'un modele dans le buffer d'envoi bu
  6. C=======================================================================
  7. integer mn3,nlconmo,nfor,nmat,nObMod,nbrobl,nbrfac,n1
  8. integer iMod,iInfo,iNomid
  9. integer bufPos
  10. integer lonBuf
  11. integer iNoCo
  12. integer iObl,iFac
  13. integer lconmo
  14. -INC CCOPTIO
  15. -INC SMMODEL
  16. segment BUFFER
  17. character ffer(lonBuf)
  18. endsegment
  19. pointeur pNomid.NOMID
  20. pointeur pModel.MMODEL
  21. pointeur modele.IMODEL
  22. pointeur bu.BUFFER
  23.  
  24. C write(ioimp,*) 'Entre dans CUPMOD'
  25. C write(ioimp,*) 'Position du buffer',bufPos
  26. lonBuf=bu.ffer(/2)
  27. call mpiupI(n1,1,bu,bufPos)
  28. if(pModel.ne.0)then
  29. segact pModel*mod
  30. segadj pModel
  31. else
  32. segini pModel
  33. endif
  34. if(n1.ne.0) then
  35. do iMod=1,n1
  36. C write(ioimp,*) 'Modele elem',iMod,'sur',n1
  37. call mpiupI(mn3,1,bu,bufPos)
  38. C write(ioimp,*) 'Position du buffer',bufPos
  39. call mpiupI(nlconmo,1,bu,bufPos)
  40. C write(ioimp,*) 'Position du buffer',bufPos
  41. call mpiupI(nfor,1,bu,bufPos)
  42. C write(ioimp,*) 'Position du buffer',bufPos
  43. call mpiupI(nmat,1,bu,bufPos)
  44. C write(ioimp,*) 'Position du buffer',bufPos
  45. call mpiupI(nObMod,1,bu,bufPos)
  46. C write(ioimp,*) 'Position du buffer',bufPos
  47. C write(ioimp,*) 'Taille du modele',mn3, nlconmo, nfor,nmat,nObMod
  48. segini modele
  49. pModel.kmodel(iMod)=modele
  50. C write(ioimp,*) 'ss modele', iMod, 'pointeur',modele
  51. call mpiupI( modele.imamod,1,bu,bufPos)
  52. call mpiupI( modele.nefmod,1,bu,bufPos)
  53. call mpiupI( modele.infmod(1),mn3,bu,bufPos)
  54. call mpiupC( modele.conmod,lconmo,bu,bufPos)
  55. call mpiupC( modele.cmatee,8,bu,bufPos)
  56. call mpiupC( modele.formod,16*nfor,bu,bufPos)
  57. call mpiupC( modele.matmod,16*nmat,bu,bufPos)
  58. call mpiupI( iNoCo,1,bu,bufPos)
  59. modele.ipdpge=iNoCo
  60. call mpiupI( modele.imatee,1,bu,bufPos)
  61. call mpiupI( modele.inatuu,1,bu,bufPos)
  62. call mpiupI( modele.ideriv,1,bu,bufPos)
  63. do iNomid=1,14
  64. C write(ioimp,*) 'nomid',iNomid,'sur 14'
  65. call mpiupI( nbrobl,1,bu,bufPos)
  66. call mpiupI( nbrfac,1,bu,bufPos)
  67. segini pNomid
  68. modele.lnomid(iNomid)=pNomid
  69. call mpiupC(pNomid.lesobl(1),nbrobl*8,bu,bufPos)
  70. call mpiupC( pNomid.lesfac(1),nbrfac*8,bu,bufPos)
  71. do iObl=1,nbrObl
  72. C write(ioimp,*) 'Obl',iObl,'/',nbrobl,pNomid.lesobl(iObl)
  73. enddo
  74. do iFac=1,nbrFac
  75. C write(ioimp,*) 'Fac',iFac,'/',nbrFac,pNomid.lesFac(iFac)
  76. enddo
  77. C write(ioimp,*) 'Position du buffer',bufPos
  78. segdes pNomid
  79. enddo
  80. C write(ioimp,*) 'Nomids recus'
  81. C write(ioimp,*) 'Position du buffer',bufPos
  82. call mpiupI( modele.infele(1),16,bu,bufPos)
  83. C write(ioimp,*) 'Infele recus'
  84. C write(ioimp,*) 'Position du buffer',bufPos
  85. C write(ioimp,*) 'Nombre d objets',nObMod
  86. if(nObMod.gt.0) then
  87. call mpiupC( modele.tymode(1),nObMod*8,bu,bufPos)
  88. C write(ioimp,*) 'Liste des types recue'
  89. C write(ioimp,*) 'Position du buffer',bufPos
  90. call mpiupI( modele.ivamod(1),nObMod,bu,bufPos)
  91. C write(ioimp,*) 'Liste des pointeurs recue'
  92. C write(ioimp,*) 'Position du buffer',bufPos
  93. endif
  94. segdes modele
  95. enddo
  96. else
  97. write(ioimp,*) 'Modele vide'
  98. endif
  99.  
  100. segdes pModel
  101. C write(ioimp,*) 'Sortie de CUPMOD'
  102. C write(ioimp,*) 'Position du buffer',bufPos
  103. end
  104.  
  105.  
  106.  

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