C CPALIS SOURCE PV 17/12/05 21:15:31 9646 subroutine cpalis(argume,jcolac,nNod,bu,bufPos) C======================================================================= C Sous-programme cpalis (Collaborateur PAQuettage LIste) C Enregistre le message complet a envoyer dans le buffer bu a partir de C la position bufPos C Il faut s'assurer au prealabe que la taille du buffer est C suffisante, C======================================================================= integer iPile integer iPoint,nNoeud integer nNod integer bufPos integer iArgu,nArg character*(8) typNom -INC PPARAM -INC CCOPTIO -INC TMCOLAC segment LISARG character*8 nom(nArg) integer adress(nArg) endsegment segment BUFFER character ffer(lonBuf) endsegment segment LISNOD integer liste(nNoeud) endsegment pointeur jcolac.ICOLAC pointeur lisNoe.ITLACC pointeur bu.BUFFER pointeur seg2pi.ILISSE pointeur argume.LISARG C Liste de passage de la numerotation actuelle vers la numerotation C de communication pointeur ac2co.LISNOD pointeur co2ac.LISNOD C write(ioimp,*) 'Entree dans CPALIS' C nbPile=jcolac.kcola(/1) C lonBuf=bu.ffer(/2) co2ac=jcolac.kcola(32) nNoeud= nNod segini ac2co call clinin(co2ac,ac2co) nNoeud=co2ac.liste(/1) seg2pi = jcolac.ilissg nArg=argume.adress(/1) C pour chaque argument do 3 iArgu =1,nArg C recuperer son type typNom = argume.nom(iArgu) C recuper le numero de pile associe call typfil (typNom,iPile) iPoint = argume.adress(iArgu) if(iimpi.ge.7) then write(ioimp,*) 'Paquettage d un objet',typNom, iPoint endif if(iPoint.eq.0) then if(iimpi.ge.7) then write(ioimp,*) 'Pointeur nul, passage a l objet suivant' endif goto 3 endif C Redirection vers le traitement correspondant au type de la pile c a toutes fins utiles, les etiquettes suivantes sont ranges par ligne de 10 goto( & 0100, 0200, 0300, 0400, 0500, 0600, 0700, 0800, 0900, 1000, & 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000, & 2100, 2200, 2300, 2400, 2500, 2600, 2700, 2800, 2900, 3000, & 3100, 3200, 3300, 3400, 3500, 3600, 3700, 3800, 3900, 4000, & 4100, 4200, 4300, 4400, 4500, 4600, 4700), iPile goto 2 c ******************** meleme ******************** 0100 continue call cpamel(iPoint,ac2co,seg2pi,bu,bufPos) goto 1 c ******************** chpoint ******************** 0200 continue call cpacpo(iPoint,seg2pi,bu,bufPos) goto 1 c ******************** mrigid ******************** 0300 continue call cparig(iPoint,seg2pi,bu,bufPos) goto 1 c ******************** ******************** 0400 continue goto 1 c ******************** ******************** 0500 continue goto 1 c ******************** bloq ******************** 0600 continue goto 1 c ******************** elem ******************** 0700 continue goto 1 c ******************** msolut ******************** 0800 continue goto 1 c ******************** mstruc ******************** 0900 continue goto 1 c ******************** mtable ******************** 1000 continue goto 1 c ******************** ******************** 1100 continue goto 1 c ******************** msostu ******************** 1200 continue goto 1 c ******************** imatri ******************** 1300 continue goto 1 c ******************** mjonct ******************** 1400 continue goto 1 c ******************** mattac ******************** 1500 continue goto 1 c ******************** mmatri ******************** 1600 continue goto 1 c ******************** mdefor ******************** 1700 continue goto 1 c ******************** mlreel ******************** 1800 continue goto 1 c ******************** mlenti ******************** 1900 continue goto 1 c ******************** mcharg ******************** 2000 continue goto 1 c ******************** ******************** 2100 continue goto 1 c ******************** mevoll ******************** 2200 continue goto 1 c ******************** superele ******************** 2300 continue goto 1 c ******************** logique ******************** 2400 continue C call cpalog(pilLoc,iPoint,bu,bufPos) goto 1 c ******************** flottant ******************** 2500 continue C call cparee(pilLoc,iPoint,bu,bufPos) goto 1 c ******************** entier ******************** 2600 continue C call cpaent(iPoint,bu,bufPos) goto 1 c ******************** mot ******************** 2700 continue C call cpamot(pilLoc,iPoint,bu,bufPos) goto 1 c ******************** texte ******************** 2800 continue goto 1 c ******************** listmots ******************** 2900 continue goto 1 c ******************** vecteur ******************** 3000 continue goto 1 c ******************** vectd ******************** 3100 continue goto 1 c ******************** point ******************** 3200 continue call cpanod(iPoint,bu,bufPos) goto 1 c ******************** config ******************** 3300 continue call cpacfg(iPoint,co2ac,bu,bufPos) goto 1 c ******************** mlchpo ******************** 3400 continue goto 1 c ******************** mbasem ******************** 3500 continue goto 1 c ******************** procedur ******************** 3600 continue goto 1 c ******************** bloc ******************** 3700 continue goto 1 c ******************** mmodel ******************** 3800 continue call cpamod(iPoint,ac2co,seg2pi,bu,bufPos) goto 1 c ******************** mchaml ******************** 3900 continue call cpachm(iPoint,seg2pi,bu,bufPos) goto 1 c ******************** minte ******************** 4000 continue call cpamin(iPoint,bu,bufPos) goto 1 c ******************** nuage ******************** 4100 continue goto 1 c ******************** matrak ******************** 4200 continue goto 1 c ******************** matrik ******************** 4300 continue goto 1 c ******************** objet ******************** 4400 continue goto 1 c ******************** methode ******************** 4500 continue goto 1 c ******************** esclave ******************** 4600 continue goto 1 c ******************** fantome ******************** 4700 continue goto 1 c ************************************************** C Gestion des erreurs 2 continue write(ioimp,*) 'Probleme dans la pile',typNom, iPile moterr(1:8)=typNom call erreur (336) goto 3 C Fin du case 1 continue C Mise a jour du compteur d elements envoyes if(iimpi.ge.7) then write(ioimp,*) 'Objet paquette' write(ioimp,*) 'Position du buffer',bufPos endif C Fin de la boucle sur les piles 3 continue segsup ac2co C write(ioimp,*) 'Sortie de CPALIS' end