C SUPPIL    SOURCE    CB215821  17/12/06    21:15:09     9651           
      SUBROUTINE SUPPIL (ICOLAC,IVOULU)
C=======================================================================
C      CE SOUPROGRAMME SUPPRIME LA PILE ICOLAC ET LES PILES ASSOCIEES
C      SAUF  LA PILE IVOULU ET LE ISGTR ASSOCIE SI IVOULU.GT.0
C    SI IVOULU.EQ.0 on desactive tout et on garde icolac dans ipsauv
C  du common Coptio
C  ENTREE     :
C                ICOLAC POINTEUR SUR LE SEGMENT A SUPPRIMER
C                IVOULU NUMERO DE PILE A GARDER OU 0
C  APPELE PAR :  SAUV  PILOBJ
C  APPELLE    :
C  ECRIT PAR  :  LENA
C=======================================================================
C  TABLEAU KCOLA :
C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6
C    7          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
C=======================================================================
C
      IMPLICIT INTEGER(I-N)
-INC PPARAM
-INC CCOPTIO
-INC TMCOLAC
C
C
C  **** ON SUPPRIME LES PILES UNE A UNE si IVOULU.NE.0
C       ----------------------
      IF (ICOLAC.EQ.0) GO TO 2
      IF(IVOULU.NE.0) THEN
         SEGACT ICOLAC
         NITLAC=KCOLA(/1)
         DO 300 I=1,NITLAC
           IF(I.NE.IVOULU) THEN
            ITLACC=KCOLA(I)
            IF (ITLACC.NE.0) SEGSUP ITLACC
            ISGTR=ICOLA(I)
            IF (ISGTR.NE.0) SEGSUP ISGTR
           ENDIF
 300     CONTINUE
         ILISSE=ILISSG
         SEGSUP ILISSE
         ILISSE=ILISSP
         SEGSUP ILISSE
         ILISSE=ILISSF
         SEGSUP ILISSE
         SEGSUP ICOLAC
      ELSE
         SEGACT ICOLAC*MOD
         DO 1 I=1,KCOLA(/1)
         ITLACC=KCOLA(I)
         KCOLAC(I)=ITLAC(/1)
         SEGDES ITLACC
         CALL SAVSEG(ITLACC)
         ISGTR=ICOLA(I)
         SEGDES ISGTR
         CALL SAVSEG(ISGTR)
    1    CONTINUE
         ILISSE=ILISSG
         SEGDES ILISSE
         CALL SAVSEG(ILISSE)
         ILISSE=ILISSP
         SEGDES ILISSE
         CALL SAVSEG(ILISSE)
         ILISSE=ILISSF
         SEGDES ILISSE
         CALL SAVSEG(ILISSE)
         SEGDES ICOLAC
         IPSAUV = ICOLAC
         CALL SAVSEG(ICOLAC)
      ENDIF
   2  RETURN
      END