Télécharger la plaquette Cast3M


fr en

Télécharger suppil.eso

Retour à la liste

Numérotation des lignes : 

suppil

  1. C SUPPIL    SOURCE    CB215821  17/12/06    21:15:09     9651           
  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 PPARAM
  24. -INC CCOPTIO
  25. -INC TMCOLAC
  26. C
  27. C
  28. C  **** ON SUPPRIME LES PILES UNE A UNE si IVOULU.NE.0
  29. C       ----------------------
  30.       IF (ICOLAC.EQ.0) GO TO 2
  31.       IF(IVOULU.NE.0) THEN
  32.          SEGACT ICOLAC
  33.          NITLAC=KCOLA(/1)
  34.          DO 300 I=1,NITLAC
  35.            IF(I.NE.IVOULU) THEN
  36.             ITLACC=KCOLA(I)
  37.             IF (ITLACC.NE.0) SEGSUP ITLACC
  38.             ISGTR=ICOLA(I)
  39.             IF (ISGTR.NE.0) SEGSUP ISGTR
  40.            ENDIF
  41.  300     CONTINUE
  42.          ILISSE=ILISSG
  43.          SEGSUP ILISSE
  44.          ILISSE=ILISSP
  45.          SEGSUP ILISSE
  46.          ILISSE=ILISSF
  47.          SEGSUP ILISSE
  48.          SEGSUP ICOLAC
  49.       ELSE
  50.          SEGACT ICOLAC*MOD
  51.          DO 1 I=1,KCOLA(/1)
  52.          ITLACC=KCOLA(I)
  53.          KCOLAC(I)=ITLAC(/1)
  54.          SEGDES ITLACC
  55.          CALL SAVSEG(ITLACC)
  56.          ISGTR=ICOLA(I)
  57.          SEGDES ISGTR
  58.          CALL SAVSEG(ISGTR)
  59.     1    CONTINUE
  60.          ILISSE=ILISSG
  61.          SEGDES ILISSE
  62.          CALL SAVSEG(ILISSE)
  63.          ILISSE=ILISSP
  64.          SEGDES ILISSE
  65.          CALL SAVSEG(ILISSE)
  66.          ILISSE=ILISSF
  67.          SEGDES ILISSE
  68.          CALL SAVSEG(ILISSE)
  69.          SEGDES ICOLAC
  70.          IPSAUV = ICOLAC
  71.          CALL SAVSEG(ICOLAC)
  72.       ENDIF
  73.    2  RETURN
  74.       END
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  

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