Télécharger cpamel.eso

Retour à la liste

cpamel
C CPAMEL    SOURCE    PV        17/12/05    21:15:33     9646           
      subroutine cpamel(pMelem,lisNoe,seg2pi,bu,bufPos)
C=======================================================================
C     COLlaborateur PAQuettage MELeme
C     Ajout du maillage pMeleme dans le buffer d'envoi bu
C     Les numeros de noeuds sont "traduit" par la
C     corespondance lisNoe passé en argument
C=======================================================================
      integer nbnn, nbelem, nbsous, nbref
      integer bufPos
      integer lonBuf
      integer iNoCo,iNoLo
      integer iNoeud,jNoeud,iRef,iSous
      integer ipoPi,iPoint
      integer sePGCD
 
-INC PPARAM
-INC CCOPTIO
-INC SMELEME
-INC TMCOLAC
      segment BUFFER
      character ffer(lonBuf)
      endsegment
      segment LISNOD
      integer liste(nNoeud)
      endsegment
      pointeur pMelem.MELEME
      pointeur lisNoe.LISNOD
      pointeur bu.BUFFER
      pointeur seg2pi.ILISSE
 
C      write(ioimp,*) 'Entre dans CPAMEL'
      if (pMelem.ne.0) then
         segact pMelem
         lonBuf=bu.ffer(/2)
         sePGCD=seg2pi.npgcd
C         write(ioimp,*)'Taille du buffer',lonBuf
         nbnn  =pMelem.num(/1)
         nbelem=pMelem.num(/2)
         nbsous=pMelem.lisous(/1)
         nbref =pMelem.lisref(/1)
C Ecriture du type d'element
C      write(ioimp,*)' Ecriture du type delement',pMelem.itypel
         call mpipaI(pMelem.itypel,1,bu,bufPos)
C Ecriture du nombre de sous maillages
C      write(ioimp,*) 'Ecriture du nombre de sous maillages',nbsous
         call mpipaI(nbsous,1,bu,bufPos)
C Ecriture du nombre de references
C      write(ioimp,*)'Ecriture du nombre de references',nbref
         call mpipaI(nbref,1,bu,bufPos)
C Ecriture du nombre d'element / noeud par element
C      write(ioimp,*)'Ecriture du nombre d elements et noeud par element',
C     &nbnn,nbelem
         call mpipaI(nbnn,1,bu,bufPos)
         call mpipaI(nbelem,1,bu,bufPos)
C Ecriture de la position des sous-maillages dans la pile
C      write(ioimp,*) 'Ecriture de la position des sous-maillages dans la
C     &pile'
         do iSous=1,nbsous
C            write(ioimp,*) 'Sous maillage :',iSous
         iPoint=pMelem.lisous(iSous)
C            write(ioimp,*) 'Pointeur: ',iPoint
         iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
         call mpipaI(iPoPi,1,bu,bufPos)
         enddo
C Ecriture de la position des references dans la pile
C      write(ioimp,*)'Ecriture de la position des references dans la pile'
         do iRef=1,nbref
C            write(ioimp,*) 'Reference :',iRef
         iPoint=pMelem.lisref(iRef)
C            write(ioimp,*) 'Pointeur: ',iPoint
         iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
C            write(ioimp,*) 'Numeroa dans la pive: ',ipoPi
         call mpipaI(iPoPi,1,bu,bufPos)
         enddo
C Ecriture de la connectivite
C        write(ioimp,*) 'Ecriture de la connectivite'
         do jNoeud=1,nbelem
         do iNoeud=1,nbnn
C            write(ioimp,*) 'element',jNoeud,'noeud',iNoeud
         iNoLo=pMelem.num(iNoeud,jNoeud)
C               write(ioimp,*) 'iNoLo',iNoLo
         iNoCo=lisNoe.liste(iNoLo)
C               write(ioimp,*) 'iNoCo',iNoCo
         call mpipaI(iNoCo,1,bu,bufPos)
         enddo
         enddo
 
C         write(ioimp,*) 'Ecriture de la couleur'
         if(nbelem.gt.0) then
            call mpipaI(pMelem.icolor(1),nbelem,bu,bufPos)
         endif
         segdes pMelem
      else
         write(ioimp,*) 'Erreur: pointeur vers un objet MELEME nul'
         call erreur(5)
      endif
C      write(ioimp,*) 'Sortie de CPAMEL'
      end
 
 
 
 
 

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