C CENV      SOURCE    PV        20/03/30    21:15:45     10567          
      subroutine CENV(colDes,iComm)
C L'operateur CENV (COLlaborateur ENVoyer) permet d'envoyer une liste d'objet en
C argument au collaborateur colDes, donne également en argument
CEn se basant sur le fonctionnement du sauver, le fonctionnement est le
C suivant :
C     -Recuperer la liste des arguments
C     -Verifier que le type des objets est correct
C     -Faire un premier remplissage des piles avec la liste d'argument
C     -Chercher les objets nécessaires pour la liste d'argument
C     -Envoyer cette liste
C     -Recevoir la liste des objets a envoyer
C     -Chercher la taille du buffer et l'allouer
C     -Remplir le buffer
C     -Envoyer le buffer
C     -FIN
C Declaration des variables
      character*(8) typNom
      integer typNum
      integer nArg
      integer iComm
      integer iretou,i,ipile
      integer iPoint,nNoeud
      integer colDes,colMoi
      integer lonBuf
      integer taille
      integer bufPos
      integer nitlac
      integer totCol
      integer tagPre,tagMan,tagObj
C     Variable pour la lecture des entiers
      real*8 xval
      integer ival
      character*512 cval
      logical logval
      integer iob
      integer nbRee,nbCha,nbMot


-INC PPARAM
-INC CCOPTIO
-INC COCOLL
-INC SMCOORD
-INC TMCOLAC
-INC CCASSIS
-INC CCNOYAU
C Declaration des types de segment
      segment BUFFER
         character ffer(lonBuf)
      endsegment
      segment PILOC
             real*8 reel(nbRee)
             character*(nbCha)  chara
             integer motdeb(nbMot+1)
      endsegment
      segment LISARG
         character*8 nom(nArg)
         integer     adress(nArg)
      endsegment
      pointeur argume.LISARG
      pointeur lisMan.LISARG
      pointeur lisReq.LISARG
c        Pointeur des gestions des assistants
c      pointeur mestra.MESTRA
      pointeur piles.LISPIL
      pointeur jcolac.ICOLAC
      pointeur lcolac.ICOLAC
      pointeur pilReq.ICOLAC
      pointeur jtlacc.ITLACC
      pointeur jlisse.ILISSE
      pointeur bu.BUFFER
      pointeur pilLoc.PILOC
      if(iimpi.ge.7) then
      write(ioimp,*) 'Entre dans CENV'
      write(ioimp,*) icomm
      endif
      nbRee=0
      nbCha=0
      nbMot=0
      lonBuf=0
      colMoi=0
      tagPre=12
      tagMan=14
      tagObj=15
      totCol=0
      piles = piComm
C     write(ioimp,*) 'piComm dans cenv',piles
      segact piles
C     Il faut garder le segments piles actifs, cela permet de bloquer
C     en ecriture le segment et donc de bloquer les appels a cfin
C     avant que les envois et receptions ne soient termines
C     Ce blocage n'empeche pas des envois / receptions simultanee car
C     on active en lecture, seul cdeb et cfin activent en mod
      segini pilLoc
      pilLoc.motDeb(1)=1
      call mpinbc ( totCol)
      if(icomm.eq.mpiComCa) then
         if(colDes.gt.totCol.or.colDes.lt.1) then
            write(ioimp,*)'Le numero du destinataire n''est pas correct'
            write(ioimp,*) colDes
            moterr( 1: 8) = 'collabor'
            call erreur(645)
            return
         else
            if(iimpi.ge.6) then
               write(ioimp,*) 'Debut de l''envoi au collaborateur ',
     &      (colDes)
            endif
         endif
      else
         if(iimpi.ge.6) then
            write(ioimp,*) 'Debut de l''envoi vers l''exterieur ',
     &      icomm, colDes
         endif
      endif
      call mpirgc ( colMoi )

      nArg=0
      segini argume
C     INTEXT est une variable globale (cf CCNOYAU)
      intext=1
      typNom=' '
C lecture d'un possible premier argume
      call quetyp(typNom,0,iretou)
      do while(iretou.eq.1)
c------- on controle la validite du type demande
      typNum=0
      call typfil (typNom,typNum)
      if (typNum.eq.1 ) then
         call lirobj(typNom,iPoint,1,iretou)
         elseif (typNum.eq.2 ) then
         call lirobj(typNom,iPoint,1,iretou)
         elseif (typNum.eq.3 ) then
         call lirobj(typNom,iPoint,1,iretou)
         elseif (typNum.eq.24) then
         call lirlog(logval,1,iretou)
         if(logval) then
            iPoint=1
         else
            iPoint=0
         endif
         elseif (typNum.eq.25) then
         call lirree(xval,1,iretou)
         nbRee=nbRee+1
         segadj pilLoc
         iPoint=nbRee
         pilLoc.reel(iPoint)=xval
         elseif (typNum.eq.26) then
         call lirent(ival,1,iretou) 
         iPoint=ival
         elseif (typNum.eq.27) then
         call lircha(cval,1,ival)
         nbMot=nbMot+1
         nbCha=nbCha+ival
         segadj pilLoc
         iPoint=nbMot
         pilLoc.motDeb(nbMot+1)=nbCha+1
         pilLoc.chara(nbCha-ival+1:nbCha)=cval(1:ival)
         elseif (typNum.eq.32) then
         call lirobj(typNom,iPoint,1,iretou)
         elseif (typNum.eq.33) then
         call lirobj(typNom,iPoint,1,iretou)
         elseif (typNum.eq.38) then
         call lirobj(typNom,iPoint,1,iretou)
         elseif (typNum.eq.39) then
         call lirobj(typNom,iPoint,1,iretou)
      else
         moterr(1:8)=typNom
         call erreur(39)
         return
      endif

c------- le type est ok, on l'ajoute a la liste
      nArg=nArg+1
      segadj argume
      argume.nom(nArg)=typNom
      argume.adress(nArg)=iPoint
      if(iimpi.ge.7) then
         write(ioimp,*) 'Ajout d un argument de type ',typNom
         write(ioimp,*) 'et de pointeur ',iPoint
      endif
C        On test s'il y a encore qq ch dans la pile pour savoir si on
C        refait une iteration ou pas
      intext=1
      typNom=' '
      call quetyp(typNom,0,iretou)
      enddo
      iretou = 0

      if (nArg.eq.0) then
         segdes argume
         segsup argume
         moterr(1:8)='        '
         call erreur(37)
      else
C         write(ioimp,*) 'Nombre d'objets a sauver', nArg
      endif
C     Si on est le propre destinataire, inutile d'enoyer les objets
      if(colMoi+1.ne.colDes.or.icomm.ne.mpicomCa) then
C Premier remplissage des piles avec la liste d'arguments lus
         typNom='        '
         typNum=-1
         call typfil(typNom,typNum)
         nitlac=-typNum
         call crepil(pilReq,nitlac)
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CC *   attention aux assistants ....
*te         if (nbesc.ne.0) then
C          if (iimpi .eq. 1234)
c        write(ioimp,*) 'il faut bloquer les assistants'
C         mestra=imestr
C         segact mestra*mod
*te            call threadii
C         call ooofrc(1)
C         call setass(1)
*te         endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
         call filllu(argume,pilReq)
C Second remplissage avec les objets references
         segact argume*mod
         segact mcoord
         call fillpi(pilReq)
         segdes mcoord
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
*te         if (nbesc.ne.0) then
C         call setass(0)
C         call ooofrc(0)
C         segact mestra
*te            call threadis
*te         endif
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
         segact pilReq*mod
C      write(ioimp,*) 'activation du segment de comm', colDes, jcolac
            lcolac = piles.proc(colDes)
            segini,jcolac=lcolac
C         segact jcolac*mod
            jlisse = jcolac.ilissg
            segact jlisse*mod 
            do ipile=1,jcolac.kcola(/1)
            jtlacc=jcolac.kcola(ipile)
            if(jtlacc.gt.0) segact jtlacc*mod
            enddo 
            call cinipi(jcolac)
C Ajout des piles pilReq dans jcolac et renumerotation de pilReq
         call cajppi(pilReq,jcolac,.true.)
C      write(ioimp,*) 'desactivation du segment de comm', colDes, jcolac
            do ipile=1,jcolac.kcola(/1)
            jtlacc=jcolac.kcola(ipile)
            if(jtlacc.gt.0) segdes jtlacc
            enddo 
            segdes jlisse

C Conversion des piles pilReq et list lisReq
         nArg=0
         segini lisReq
C         call savseg(lisReq)
         call cpi2li(pilReq,lisReq)
         call clibpi(pilReq)
         if(iimpi.ge.7) then
            write(ioimp,*) 'Objets dans la liste des prerequis:'
            do i=1,lisReq.adress(/1)
            write(ioimp,*) i,lisReq.adress(i),lisReq.nom(i)
            enddo
         endif
C Mesure de la liste lisReq
         lonBuf=0
         call cmearg(lisReq,taille)
         lonBuf = lonBuf + taille
C Allocation du buffer
         segini bu
         bufPos=0
C        Paquettage de la liste des objets necessaires
         call cpaarg(lisReq,bu,bufPos)
         segsup lisReq
C     Envoi de la liste des objets necessaires
         if(iimpi.ge.6) then
            write(ioimp,*) 'Envoi de la liste des prerequis au coll',
     &       colDes
            write(ioimp,*) 'Longueur du buffer :', bufPos
         endif
         call mpiEnv(colDes,iComm,tagPre,bu,bufPos)
c        Reception de la liste des objets a envoyer
            if(iimpi.ge.6) then         
               write(ioimp,*) 'Attente de la liste des objets a envoyer'
            endif
            call mpiRcv(colDes,iComm,tagMan,bu)
            bufPos = 0
            nArg=0
C        Extraction de la liste des objets a envoyer du buffer
            call cuparg(bu,bufPos,lisMan)
            segsup bu
C        Conversion dans lisMan des positions dans la pile en pointeur
            segact jlisse
            do ipile=1,jcolac.kcola(/1)
            jtlacc=jcolac.kcola(ipile)
            if(ipile.lt.24.or.ipile.gt.27) then
               if(jtlacc.gt.0) segact jtlacc
            else
               if(jtlacc.gt.0) segact jtlacc*mod
            endif
            enddo 
            if(iimpi.ge.6) then         
               write(ioimp,*) 'Liste des objets manquants recus'
            endif
         call clip2s(jcolac,lisMan)
C        Calcul de la taille du message et allocation
         lonBuf=0
         call cmelis(lisMan,jcolac,taille)
         lonBuf = lonBuf + taille
         call cmeplo(pilLoc,taille)
         lonBuf = lonBuf + taille
         call cmearg(argume,taille)
         lonBuf = lonBuf + taille
C         write(ioimp,*) 'allocation d un buffer de taille',lonBuf
         segini bu
         bufPos=0
C     Paquettage des objets
         if(iimpi.ge.6) then
            write(ioimp,*) 'Paquettage des objets'
         endif
         call cpaplo(pilLoc,bu,bufPos)
         segsup pilLoc
         segact mcoord
         nNoeud=nbpts
         call cpalis(lisMan,jcolac,nNoeud,bu,bufPos)
         segdes mcoord

         segsup lisMan
C     Renumerotation de la liste des arguments
         call clis2p(jcolac,argume)
            do ipile=1,jcolac.kcola(/1)
            jtlacc=jcolac.kcola(ipile)
            if(ipile.lt.24.or.ipile.gt.27) then
               segdes jtlacc
            else
C                  call libseg(jtlacc)
               segsup jtlacc
               jcolac.kcola(ipile)=0
            endif
            enddo 
            segdes jlisse 
            segsup jcolac

C     Paquettage des la liste des objets a retourner
         if(iimpi.ge.6) then
            write(ioimp,*) 'Paquettage de la liste des arguments'
         endif
         call cpaarg(argume,bu,bufPos)
         segdes argume
C         call libseg(argume)
         segsup argume
C     Envoi du message
         if(iimpi.ge.6) then
            write(ioimp,*) 'Envoi des objets au coll',colDes
         endif
C         if (nbesc.ne.0) then
C            segdes mestra
C         endif
         call mpiEnv(colDes,iComm,tagObj,bu,bufPos)
         if(iimpi.ge.6) then
            write(ioimp,*) 'Fin de l''envoi a ',colDes
         endif
      else
C         Cas d'un message envoyer a soi meme
         call cmearg(argume,taille)
         lonBuf = taille
         call cmeplo(pilLoc,taille)
         lonBuf = lonBuf+taille
C         write(ioimp,*) 'allocation d un buffer de taille',lonBuf
         segini bu
         bufPos=0
         call cpaplo(pilLoc,bu,bufPos)
         segsup pilLoc
         call cpaarg(argume,bu,bufPos)
         segdes argume
         segsup argume
C        Envoi du message
         if(iimpi.ge.6) then
            write(ioimp,*) 'Envoi du message a soi meme '
         endif
         call mpiEnv(colDes,iComm,tagObj,bu,bufPos)
      endif
      segdes piles

C     L'envoi est termine, on peut debloquer le segment piles (cf
C     remarque lors de l'activation de ce segment)
C      write(ioimp,*) 'Sortie de CENV'
      end