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