Download libpil.eso

Back to the list

   1 : C LIBPIL    SOURCE    FANDEUR   12/07/05    21:15:58     7424           
   2 : 
   3 : C=======================================================================
   4 : C CE SOUPROGRAMME LIBERE DU NOYAU PUIS DETRUIT LA PILE ICOLAC ET LES 
   5 : C PILES ASSOCIEES 
   6 : C=======================================================================
   7 : C
   8 :       SUBROUTINE LIBPIL (ICOLAC)
   9 : C
  10 :       IMPLICIT INTEGER(I-N)
  11 : C
  12 : -INC TMCOLAC
  13 : C
  14 :       IF (ICOLAC.EQ.0) RETURN
  15 : C* Desactivation de l'horodatage pour pouvoir supprimer les segments
  16 : C* pointes dans ICOLAC et qui ont ete crees dans un precedent operateur
  16 :       CALL ooohor(0,0)
  17 :       SEGACT,ICOLAC
  18 :       NITLAC = KCOLA(/1)
  19 :       DO I = 1, NITLAC
  20 :         ITLACC = KCOLA(I)
  21 :         IF (ITLACC.NE.0) THEN
  21 :           CALL LIBSEG(ITLACC)
  22 :           SEGSUP,ITLACC
  23 :         ENDIF
  24 :         ISGTR = ICOLA(I)
  25 :         IF (ISGTR.NE.0) THEN
  25 :           CALL LIBSEG(ISGTR)
  26 :           SEGSUP,ISGTR
  27 :         ENDIF
  28 :       ENDDO
  29 :       ILISSE = ILISSG
  30 :       IF (ILISSE.NE.0) THEN
  30 :         CALL LIBSEG(ILISSE)
  31 :         SEGSUP,ILISSE
  32 :       ENDIF
  32 :       CALL LIBSEG(ICOLAC)
  33 :       SEGSUP,ICOLAC
  34 :       ICOLAC = 0
  35 : 
  36 :       RETURN
  37 :       END
  38 : 
  39 :  

© Cast3M 2003 - All rights reserved.
Disclaimer