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