Télécharger la plaquette Cast3M


fr en

Télécharger cupchm.eso

Retour à la liste

Numérotation des lignes : 

cupchm

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

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