Télécharger crec.eso

Retour à la liste

crec
C CREC      SOURCE    PV        17/12/05    21:15:41     9646           
      subroutine crec(colExp,iComm)
C L'operateur CREC (COLlaborateur RECevoir) permet de recevoir la liste d'objet
C envoye par le collaborateur colExp, qui doit etre fournit en
C argument.
C En basant sur le fonctionnement du rest, le fonctionnement est le
C suivant :
C     -Recuperer la liste des objets necessaire
C     -Chercher les objets manquants et envoyer la liste
C     -Recevoir les objets manquants
C     -Faire correspondre les objets references avec leur pointeur esope
C     -Retourner a l'utilisateur la liste des objets attendus
C     -Faire le menage et quitter
      integer nArg
      integer iComm
      integer iretou
      integer ipile
      integer colExp,colMoi
      integer totCol
      integer lonBuf
      integer taille
      integer bufPos
      integer nivErr
      integer tagPre,tagMan,tagObj
      integer nbRee,nbCha,nbMot
      integer nproc,iproc
      integer nitlac
      character*(8) typNom
      integer typNum
C-INC SMELEME
-INC SMCOORD
-INC TMCOLAC
C-INC CCASSIS
-INC COCOLL
 
-INC PPARAM
-INC CCOPTIO
C Declaration des types de segment
      segment BUFFER
         character ffer(lonBuf)
      endsegment
 
      segment LISARG
         character*8 nom(nArg)
         integer     adress(nArg)
      endsegment
      segment PILOC
             real*8 reel(nbRee)
             character*(nbCha)  chara
             integer motdeb(nbMot+1)
      endsegment
      pointeur pilLoc.PILOC
C Declaration des variables
      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 jtlacc.ITLACC
      pointeur jlisse.ILISSE
      pointeur bu.BUFFER
 
 
 
C      write(ioimp,*) 'Entre dans CREC'
      nivErr=0
C      write(ioimp,*) 'piComm dans crec',piles
      colMoi=0
      tagPre=12
      tagMan=14
      tagObj=15
      iretou = 0
      totCol=0
      piles = piComm
      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
      call mpinbc(totCol)
      if(icomm.eq.mpiComCa) then
         if(colExp.gt.totCol.or.colExp.lt.1) then
         write(ioimp,*)'Le numero de l''expediteur n''est pas correct'
            write(ioimp,*)colExp
            moterr( 1: 8) = 'collabor'
            call erreur(645)
            return
         else
            if(iimpi.ge.6) then
               write(ioimp,*) 'Debut de la reception depuis ',
     &         ' collaborateur'
     &         ,colExp
            endif
         endif
      else
         if(iimpi.ge.6) then
            write(ioimp,*) 'Debut de la reception depuis l''exterieur ',
     &      icomm, colExp
         endif
      endif
      call mpirgc(colMoi)
C     Activation de la pile concernee
      if(colMoi+1.ne.colExp.or.icomm.ne.mpicomCa) then
C        probe du message
C        write(ioimp,*) 'Sonde du message'
         if(iimpi.ge.6) then
            write(ioimp,*) 'En Attente de la liste des objet requis...'
         endif
         call mpiRcv(colExp, iComm, tagPre, bu)
         bufPos = 0
C        Initialisation et lecture de la liste des requis
         call cuparg(bu,bufPos,lisReq)
         segsup bu
            lcolac = piles.proc(colExp)
C           write(ioimp,*) 'activation du segment de comm', colExp, jcolac
            segini,jcolac=lcolac
            jlisse = jcolac.ilissg
            segact jlisse*mod
            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
            call cinipi(jcolac)
C        Recherche des objets manquants
         nArg=0
         segini lisMan
         call cdpili(lisReq,jcolac,lisMan)
C      write(ioimp,*) 'activation 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
 
         lonBuf=0
         call cmearg(lisMan,taille)
         lonBuf = lonBuf + taille
         segini bu
         bufPos=0
C        Paquettage de la liste des objets necessaires
         call cpaarg(lisMan,bu,bufPos)
         if(iimpi.ge.6) then
            write(ioimp,*) 'Envoi de la liste des manquants au col',
     &      icomm, colExp
         endif
         call mpiEnv(colExp,iComm,tagMan,bu,bufPos)
         if(iimpi.ge.6) then         
            write(ioimp,*) 'Liste des objets manquants envoyes'
            write(ioimp,*) 'En Attente des objets'
         endif
C        probe du message
         if(iimpi.ge.6) then         
            write(ioimp,*) 'En attente des objets'
         endif
         call mpiRcv(colExp,iComm, tagObj, bu)
         bufPos = 0
C     Initialisation et lecture de la liste des arguments
C     Lecture de l'increment de pile recu
C      write(ioimp,*) 'activation du segment de comm', colDes, jcolac
            segact jlisse*mod
            do ipile=1,jcolac.kcola(/1)
               jtlacc=jcolac.kcola(ipile)
               if(jtlacc.gt.0) segact jtlacc*mod
            enddo 
         nbRee=0
         nbCha=0
         nbMot=0
         segini pilLoc
         call cupplo(bu,bufPos,pilLoc)
         call cuplis(lisMan,bu,bufPos,jcolac,nivErr)
         if(nivErr.ne.0) return
         call cuparg(bu,bufPos,argume)
         segsup bu
C     Lie les objets references a leur pointeur esope
         if(iimpi.ge.6) then
            write(ioimp,*) 'Fin de la reception depuis le coll',colExp
         endif
         call clilis(lisMan,jcolac)
         segsup lisMan
C     Envoi des objets en sortie d'operateur
 
         call clip2s(jcolac,argume)
         call cretar(argume,pilLoc)
         segsup pilLoc
C      write(ioimp,*) 'Desactivation du segment de comm', colExp, jcolac
C Desactivation de tout les segments contenus dans jcolac
            do ipile=1,jcolac.kcola(/1)
               jtlacc=jcolac.kcola(ipile)
               if(ipile.lt.24.or.ipile.gt.27) then
                  segdes jtlacc
               else
                  segsup jtlacc
                  jcolac.kcola(ipile)=0
               endif
            enddo
            segdes jlisse
            segsup jcolac
      else
C     Message envoye a soi meme
C probe du message
         if(iimpi.ge.6) then
            write(ioimp,*) 'En Attente de la liste des arguments de soi'
         endif
         call mpiRcv(colExp, iComm, tagObj, bu)
         bufPos = 0
         nbRee=0
         nbCha=0
         nbMot=0
         segini pilLoc
         call cupplo(bu,bufPos,pilLoc)
         call cuparg(bu,bufPos,argume)
         segsup bu
         call cretar(argume,pilLoc)
         segsup pilLoc
      endif
      segdes piles
C     La reception est terminee, on peut debloquer le segment piles
C     (cf remarque lors de l'activation de ce segment)
      segsup argume
C      write(ioimp,*) 'Sortie de CREC',colExp
      end
 
 
 
 
 
 
 

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