C CLIS2P SOURCE PV 17/12/05 21:15:24 9646 SUBROUTINE clis2p (jcolac,argume) C======================================================================= C Recherche de la position pointeurs arguments dans la pile de C communication (COLlaborateur LIste: numero Segment vers numero ds Pile C La routine renumerote la liste des arguments et remplace le pointeur C esope par la position dans pile C======================================================================= integer iArgu integer nArg integer iPile integer iPoint,iPoPi integer iNoeud,nNoeud,iNoLu,iNoRec character*8 typNom integer invPGD -INC PPARAM -INC CCOPTIO -INC TMCOLAC segment LISARG character*8 nom(nArg) integer adress(nArg) endsegment pointeur invPil.ILISSE pointeur pile.ITLACC pointeur argume.LISARG pointeur jcolac.ICOLAC c Recupere la liste d'argument c Pour chaque pile nArg = argume.adress(/1) C write(ioimp,*) 'Entre dans CLIS2P' C write(ioimp,*) 'Nombre d argu',nArg c C Liste de correspondance inverse (depuis le numero de segment vers C le numero dans la pile) invPil = jcolac.ilissg invPGD = invPil.npgcd C write(ioimp,*) 'PGCD est' ,invPGD C write(ioimp,*) 'La taille de invPil est' ,invPil.iliseg(/1) C Remplacement dans argume des numeros de pointeurs vers les numero de C liste C pour chaque argument do iArgu =1,nArg C recuperer son type typNom = argume.nom(iArgu) C recuper le numero de pile associe call typfil (typNom,iPile) C chercher le numero de segment dans ilisse pile = jcolac.kcola(iPile) C write(ioimp,*) 'Dump pile ' C write(ioimp,*) (pile.itlac(i),i=1,pile.itlac(/1)) C write(ioimp,*) 'pile',iPile C Les piles suivants n'ont pas de illiseg associe C if (iPile.eq.24) then C else if (iPile.eq.25) then C else if (iPile.eq.26) then C else if (iPile.eq.27) then C else if(iPile.eq.32) then C write(ioimp,*) 'On cherche le manuellement la pile positiom' C par contre, les points peuvent ĂȘtre ajoutĂ© automatiquement, il C faut donc les chercher dans les pies iNoRec = argume.adress(iArgu) C write(ioimp,*) iNoRec nNoeud = pile.itlac(/1) C write(ioimp,*) 'dans une pile de taille',nNoeud do iNoeud=1,nNoeud iNoLu = pile.itlac(iNoeud) C write(ioimp,*) 'Le ',iNoLu if(iNoRec.eq.iNoLu) goto 42 enddo iNoeud=0 42 argume.adress(iArgu)=iNoeud C write(ioimp,*)'Argu :',iArgu,typNom,iNoeud elseif(iPile.ge.24.and.iPile.le.27) then C Pas ce changement de numerotation a faire else C on tape dans ilisseg iPoint = argume.adress(iArgu) C write(ioimp,*) 'iPoint',iPoint C write(ioimp,*) 'invPGD',invPGD iPoPi= invPil.iliseg((iPoint-1)/invPGD) C write(ioimp,*) 'iPoPi',iPoPi if(iPoPi.eq.0 .or. pile.itlac(iPoPi).ne.iPoint ) then write(ioimp,*)'Incoherence clis2p.' write(ioimp,*) 'La liste inverse n est pas correcte.' write(ioimp,*)'Probleme sur l argu :',iArgu,typNom,iPoint write (6,*) 'Recherche manuelle.' moterr(1:8)='clis2p' interr(1)=iPoint call erreur(861) do iPoPi=1,pile.itlac(/1) iNoLu = pile.itlac(iNoeud) if(iNoLu.eq.iPoint) goto 12 enddo iPoPi=0 endif 12 argume.adress(iArgu)=iPoPi C write(ioimp,*)'Argu :',iArgu,typNom,iPoPi endif enddo C write(ioimp,*) 'Sortie de CLIS2P' END