C CPACPO    SOURCE    PV        22/01/18    21:15:03     11267          
      subroutine cpacpo(pChpo,seg2pi,bu,bufPos)
C=======================================================================
C     COLlaborateur PAQuettage CHamp par POint
C     Ajout du chpo pChpo dans le buffer d'envoi bu
C=======================================================================
      integer bufPos
      integer lonBuf
      integer nat,nbComp,nbNoeu,nSoupo
      integer iSoupo
      integer ipoPi,iPoint
      integer sePGCD
C      CHARACTER*72 SOUTYP

-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC TMCOLAC
      segment BUFFER
      character ffer(lonBuf)
      endsegment
      pointeur pChpo.MCHPOI
      pointeur pSoupo.MSOUPO
      pointeur pPoval.MPOVAL
      pointeur bu.BUFFER
      pointeur seg2pi.ILISSE

C      write(ioimp,*) 'Entre dans CPACPO'
C      write(ioimp,*)'Position du buffer',bufPos
      if (pChpo.ne.0) then
         segact pChpo
C         SOUTYP=pChpo.MTYPOI
         lonBuf=bu.ffer(/2)
         sePGCD=seg2pi.npgcd
C         write(ioimp,*)'Taille du buffer',lonBuf
         nat =pChpo.jattri(/1)
C Ecriture du type
C         write(ioimp,*)' Ecriture du type'
         call mpipaC(pChpo.mtypoi,8,bu,bufPos)
C         write(ioimp,*)'Position du buffer',bufPos
C         SOUTYP=pChpo.mochde
C Ecriture de la description
C         write(ioimp,*) 'Ecriture de la description'
         call mpipaC(pChpo.mochde,72,bu,bufPos)
C         write(ioimp,*)'Position du buffer',bufPos
C Ecriture sur fourrier
C         write(ioimp,*)'Ecriture de IFOPOI',pChpo.ifopoi
         call mpipaI(pChpo.ifopoi,1,bu,bufPos)
C         write(ioimp,*)'Position du buffer',bufPos
C Ecriture des sous po
         nSoupo=pChpo.ipchp(/1)
C Ecriture du nombre de soupo
C         write(ioimp,*)'Ecriture du nombre de soupo',nSoupo
         call mpipaI(nSoupo,1,bu,bufPos)
C         write(ioimp,*)'Position du buffer',bufPos
C Ecriture du nombre de nature
C         write(ioimp,*)'Ecriture du nombre de nature',nat
         call mpipaI(nat,1,bu,bufPos)
C Ecriture de la nature
c         write(ioimp,*)'Ecriture de la nature'
         if(nat.gt.0) then
            call mpipaI(pChpo.jattri(1),nat,bu,bufPos)
         endif
         do iSoupo=1,nSoupo
C            write(ioimp,*) 'Soupo :',iSoupo
         pSoupo=pChpo.ipchp(iSoupo)
         if(pSoupo.ne.0) then
            segact pSoupo
C              Ecriture du nombre de composantes
            nbComp = pSoupo.noharm(/1)
            pPoval = pSoupo.ipoval
            if(pPoval.ne.0) then
               segact pPoval
               nbNoeu = pPoval.vpocha(/1)
            else
               nbNoeu = 0
            endif
C               write(ioimp,*)'Ecriture du nombre de composantes',nbComp
            call mpipaI(nbComp,1,bu,bufPos)
C               write(ioimp,*)'Ecriture du nombre de noeud',nbNoeu
            call mpipaI(nbNoeu,1,bu,bufPos)
            if(nbNoeu.gt.0.and.nbComp.gt.0) then
C                 Ecriture des valeurs
C                 write(ioimp,*)'Ecriture des valeurs'
               call mpipaR(pPoval.vpocha(1,1),nbNoeu*nbComp,bu,bufPos)
               segdes pPoval
            endif
C             Ecriture du maillage support
C               write(ioimp,*) 'Maillage support'
            iPoint=pSoupo.igeoc
            if(iPoint.ne.0) then
               iPoPi= seg2pi.iliseg((iPoint-1)/sePGCD)
            else
               iPoPi = 0
            endif
C               write(ioimp,*) 'Pointeur vers maillage et position dans la
C     &      pile',iPoint, iPopi
            call mpipaI(iPoPi,1,bu,bufPos)
C              Ecriture des noms des composantes
C               write(ioimp,*)'Ecriture du nom des composantes'
            if(nbComp.gt.0) then
               call mpipaC(pSoupo.nocomp(1),nbComp*4,bu,bufPos)
C                 SOUTYP=pSoupo.nocomp(1)
C                 write(ioimp,*) 'Nom composante',soutyp
C                 write(ioimp,*)'Position du buffer',bufPos

C                 Ecriture des noms des constituants
C                 write(ioimp,*)'Position du buffer',bufPos
C                 Ecriture du numero des harmoniques
C                 write(ioimp,*)'Ecriture du numero des harmoniques',
C                 & (pSoupo.noharm(i),i=1,nbComp)
               call mpipaI(pSoupo.noharm(1),nbComp,bu,bufPos)
C                 write(ioimp,*)'Position du buffer',bufPos
            endif
            segdes pSoupo
         else
C              pSoupo est nul, on l'indique avec un nombre de comp nul
C               ainsi qu'un pointeur vers un maillage nul et un nb de
C               noeud nul
            nbComp = 0
C               write(ioimp,*)'Ecriture du nombre de composantes',nbComp
            call mpipaI(nbComp,1,bu,bufPos)
            call mpipaI(nbComp,1,bu,bufPos)
            call mpipaI(nbComp,1,bu,bufPos)
         endif
         enddo
         segdes pChpo
      else
         write(ioimp,*) 'Erreur: pointeur vers un objet CHPO nul'
         call erreur(5)
      endif
C      write(ioimp,*) 'Sortie de CPACPO'
      end