C CAJPPI SOURCE PV 17/12/05 21:15:06 9646 subroutine cajppi(pilAjo,pilPri,renum) C======================================================================= C Sous-programme cajppi (Collaborateur AJoute Pile dans PIles C Ajoute les objets de la piles pilAjo dans la pile pilPri C si renum est vrai, la pile pilAjo est renumerote avec la position C dans la pile pilPri C======================================================================= logical renum integer iPil,nbPile integer iPoint integer iObj,nbObj integer lisInv -INC TMCOLAC -INC PPARAM -INC CCOPTIO pointeur pilPri.ICOLAC pointeur pilAjo.ICOLAC pointeur pilP.ITLACC pointeur pilA.ITLACC pointeur seg2pi.ILISSE C write(ioimp,*) 'Entree dans CAJPPI' C call imppil(pilPri,0) C call imppil(pilAjo,0) seg2pi = pilPri.ilissg nbPile=pilAjo.kcola(/1) do iPil=1,nbPile pilP=pilPri.kcola(iPil) pilA=pilAjo.kcola(iPil) C segact pilP*mod if(iPil.ge.24.and.iPil.le.27) then C Pile de reel, logique,entier ou mot, rien a faire elseif(iPil.eq.32) then C Pile des noeuds, construction d'une liste inverse pilP=pilPri.kcola(iPil) pilA=pilAjo.kcola(iPil) C if(renum) then C segact pilA*mod C else C segact pilA C endif call ajouLN(pilA,pilP,renum) else if(iPil.eq.36)then lisInv=0 else lisInv=1 endif if(renum) then C segact pilA*mod nbObj=pilA.itlac(/1) do iObj=1,nbObj iPoint =pilA.itlac(iObj) call ajoun(pilP,iPoint,seg2pi,lisInv) pilA.itlac(iObj)=iPoint enddo else C segact pilA nbObj=pilA.itlac(/1) do iObj=1,nbObj iPoint =pilA.itlac(iObj) call ajoun(pilP,iPoint,seg2pi,lisInv) enddo endif endif enddo C write(ioimp,*) 'Sortie de CAJPPI' return end