Télécharger la plaquette Cast3M


fr en

Télécharger libpil.eso

Retour à la liste

Numérotation des lignes : 

libpil

  1. C LIBPIL    SOURCE    CB215821  19/07/30    21:17:10     10273          
  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
  17.       CALL ooohor(0)
  18.       SEGACT,ICOLAC
  19.       NITLAC = KCOLA(/1)
  20.       DO I = 1, NITLAC
  21.         ITLACC = KCOLA(I)
  22.         IF (ITLACC.NE.0) THEN
  23.           CALL LIBSEG(ITLACC)
  24.           SEGSUP,ITLACC
  25.         ENDIF
  26.         ISGTR = ICOLA(I)
  27.         IF (ISGTR.NE.0) THEN
  28.           CALL LIBSEG(ISGTR)
  29.           SEGSUP,ISGTR
  30.         ENDIF
  31.       ENDDO
  32.       ILISSE = ILISSG
  33.       IF (ILISSE.NE.0) THEN
  34.         CALL LIBSEG(ILISSE)
  35.         SEGSUP,ILISSE
  36.       ENDIF
  37.       CALL LIBSEG(ICOLAC)
  38.       SEGSUP,ICOLAC
  39.       ICOLAC = 0
  40.  
  41.       RETURN
  42.       END
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales