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

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