Télécharger cupmod.eso

Retour à la liste

Numérotation des lignes :

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

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