C CBLOPI    SOURCE    PV        17/12/05    21:15:07     9646           
      subroutine cblopi(icolac,iiicha)
C=======================================================================
C sous-programme cblopi (COLlaborateur BLOque PIles)
C        Ajouter les piles du segment ICOLAC au noyau afin d'eviter leur
C        desallocation
C        Note : variation basse sur la sous-routine SUPPIL mais
C        impossible de se servir de cette derniere tel quel car elle va
C        chercher directement dans le common IPSAUV
C        Suppression de l'argument ivoulu qui permettait a SUPPIL de
C        soit : supprimer les piles ou les sauvegarder
C        Ceci est remplacé par deux sous-routinea différentes
C        Entree :
C                 ICOLAC: pointeur vers le segment ICOLAC a bloquer
C=======================================================================
C
      integer i
      integer iiicha
-INC TMCOLAC
      if (icolac.eq.0) return
      do  i=1,kcola(/1)
         if(i.lt.24.or.i.gt.27.or.iiicha.eq.0) then
            itlacc=kcola(i)
            call savseg(itlacc)
            segdes itlacc

            isgtr=icola(i)
            if(isgtr.ne.0) then
               call savseg(isgtr)
               segdes isgtr
            endif
         else
C     Si c'est une pile RLME (24, 25, 26, 27) et que iiicha est 1, on
C     supprime la pile car ce sont des piles temporaires qui seront
C     allouées en debut d'opérateur et libérées avant de sortir
            itlacc=kcola(i)
            segsup itlacc
            kcola(i)=0
            isgtr=icola(i)
            if(isgtr.ne.0) then
               segsup isgtr
               icola(i)=0
            endif
         endif
      enddo
      ilisse=ilissg
      segdes ilisse
      call savseg(ilisse)
      segdes icolac
      call savseg(icolac)
      end