C MENAG7    SOURCE    PV        10/06/15    21:15:21     6692           
      SUBROUTINE MENAG7(ICOLAC)
C
C elimine des itlac deja sauves ceux qui n'existent plus
C
      IMPLICIT INTEGER(I-N)
-INC CCOPTIO
-INC TMCOLAC
      segment iliss1
       integer ilise1(nliss1)
      endsegment
      IF(IPSAUV.EQ.0) RETURN
C      call imppil ( ipsauv,0)
C      call imppil (icolac,0)
       ICOLA1=IPSAUV
       SEGACT ICOLAC,ICOLA1
       ILISSE=ICOLA1.ILISSG
       SEGACT ILISSE*MOD
      NITLAC=ICOLA1.KCOLA(/1)
      nliss1=0
      segini iliss1
      DO 1 K=1,NITLAC
      IF(K.GE.24.AND.K.LE.28) GO TO 1
      IF(K.EQ.32) GO TO 1
      IF(K.EQ.36) GO TO 1
      ITLAC1=ICOLA1.KCOLA(K)
      ITLACC=KCOLA(K)
      SEGACT ITLAC1*MOD
      SEGACT ITLACC
      IFI= ITLAC(/1)
      IFI1=ITLAC1.ITLAC(/1)
      IF( IFI1.EQ.0) GO TO 10
*     write (6,*) 'ifi*ifi1 ',ifi,ifi1,ifi*ifi1
      lsf=0
*     if (ifi*ifi1.gt.65535) then
      if (ifi*ifi1.gt.16384) then
       lsf=1
       do 31 i=1,ifi
        ima=itlac(i)
        if (ima.gt.nliss1) then
         nliss1=ima*1.2
         segadj iliss1
        endif
        ilise1(ima)=i
  31   continue
       else
        lsf=0
       endif
*       if(K.eq.41) write(6,*) 'menag7 traitement pile',K,ifi,ifi1
      DO 2 I=1,IFI1
       IMA = ITLAC1.ITLAC(I)
       IF(IMA.EQ.0) go to 2
      if (lsf.eq.0) then
      DO 3 J=1,IFI
       IF(IMA.EQ.ITLAC(J)) GO TO 2
   3  CONTINUE
      else
       if (ima.le.ilise1(/1)) then
        j=ilise1(ima)
        if (j.ne.0) then
         IF(IMA.EQ.ITLAC(J)) GO TO 2
        endif
       endif
      endif
*      write(6,*) ' suppression de ',IMA
       ITLAC1.ITLAC(I)=0
      ILISEG(((IMA-1)/npgcd))=0
    2 CONTINUE
   10 CONTINUE
      SEGDES ITLACC,ITLAC1
    1 CONTINUE
      segsup iliss1
      SEGDES ICOLA1,ICOLAC,ILISSE
      RETURN
      END