Esope source files

   1 : C SUPPIL    SOURCE    CHAT      05/01/13    03:27:25     5004           
   2 :       SUBROUTINE SUPPIL (ICOLAC,IVOULU)
   3 : C=======================================================================
   4 : C      CE SOUPROGRAMME SUPPRIME LA PILE ICOLAC ET LES PILES ASSOCIEES
   5 : C      SAUF  LA PILE IVOULU ET LE ISGTR ASSOCIE SI IVOULU.GT.0
   6 : C    SI IVOULU.EQ.0 on desactive tout et on garde icolac dans ipsauv
   7 : C  du common Coptio
   8 : C  ENTREE     :
   9 : C                ICOLAC POINTEUR SUR LE SEGMENT A SUPPRIMER
  10 : C                IVOULU NUMERO DE PILE A GARDER OU 0
  11 : C  APPELE PAR :  SAUV  PILOBJ
  12 : C  APPELLE    :
  13 : C  ECRIT PAR  :  LENA
  14 : C=======================================================================
  15 : C  TABLEAU KCOLA :
  16 : C    1  MELEME  2 CHPOIN  3 MRIGID  4 MCHAFF  5 MCHELM  6
  17 : C    7          8 MSOLUT  9 MSTRUC 10        11 MAFFEC 12 MSOSTU
  18 : C   13  IMATRI 14 MJONCT 15 MATTAC 16 MMATRI 17 MDEFOR 18 MLREEL
  19 : C   19  MLENTI 20 MCHARG 21 MODELE 22 MEVOLL
  20 : C=======================================================================
  21 : C
  22 :       IMPLICIT INTEGER(I-N)
  23 : -INC CCOPTIO
  24 : -INC TMCOLAC
  25 : C
  26 : C
  27 : C  **** ON SUPPRIME LES PILES UNE A UNE si IVOULU.NE.0
  28 : C       ----------------------
  29 :       IF (ICOLAC.EQ.0) GO TO 2
  30 :       IF(IVOULU.NE.0) THEN
  31 :          SEGACT ICOLAC
  32 :          NITLAC=KCOLA(/1)
  33 :          DO 300 I=1,NITLAC
  34 :            IF(I.NE.IVOULU) THEN
  35 :             ITLACC=KCOLA(I)
  36 :             IF (ITLACC.NE.0) SEGSUP ITLACC
  37 :             ISGTR=ICOLA(I)
  38 :             IF (ISGTR.NE.0) SEGSUP ISGTR
  39 :            ENDIF
  40 :  300     CONTINUE
  41 :          ILISSE=ILISSG
  42 :          SEGSUP ILISSE
  43 :          SEGSUP ICOLAC
  44 :       ELSE
  45 :          SEGACT ICOLAC*MOD
  46 :          DO 1 I=1,KCOLA(/1)
  47 :          ITLACC=KCOLA(I)
  48 :          KCOLAC(I)=ITLAC(/1)
  49 :          SEGDES ITLACC
  49 :          CALL SAVSEG(ITLACC)
  50 :          ISGTR=ICOLA(I)
  51 :          SEGDES ISGTR
  51 :          CALL SAVSEG(ISGTR)
  52 :     1    CONTINUE
  53 :          ILISSE=ILISSG 
  54 :          SEGDES ILISSE
  54 :          CALL SAVSEG(ILISSE)     
  55 :          SEGDES ICOLAC
  56 :          IPSAUV = ICOLAC
  56 :          CALL SAVSEG(ICOLAC)   
  57 :       ENDIF
  58 :    2  RETURN
  59 :       END
  60 :  
  61 :  
  62 :  
  63 :  
  64 :  
  65 :  
  66 :