Télécharger la plaquette Cast3M


fr en

Télécharger sortri.eso

Retour à la liste

Numérotation des lignes : 

sortri

  1. C SORTRI    SOURCE    PV        17/12/05    21:17:22     9646           
  2.       SUBROUTINE SORTRI(ICOLAC)
  3.       IMPLICIT INTEGER(I-N)
  4.       IMPLICIT REAL*8 (A-H,O-Z)
  5. C ---------------------------------------------------------------------
  6. C
  7. C     CAS DES OBJETS RIGIDITES
  8. C         ET DES SUPERELEMNETS DONT ON DEMANDE LE SAUVETAGE
  9. C      LE POINTEUR EST MIS NEGATIF (PILE 3)
  10. C
  11. C PROGRAMME PAR  FARVACQUE - REPRIS PAR LENA
  12. C APPELE PAR:    SAUV
  13. C APPELLE:
  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 23 MSUPER
  20. C=======================================================================
  21. C
  22. -INC SMRIGID
  23. -INC SMSUPER
  24.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. -INC TMCOLAC
  28. C
  29. C
  30. C  **** CAS DES OBJETS RIGIDITES: ON NE SAUVE QUE LES MMATRI DES OBJETS
  31. C  **** SPECIFIES PAR L'UTILISATEUR. POUR LES RECONNAITRE ON MET LEUR
  32. C  **** POINTEUR NEGATIF
  33.       SEGACT ICOLAC
  34.       ITLACC=KCOLA(3)
  35.       IF (ITLACC.LE.0) GO TO 2
  36.       N=ITLAC(/1)
  37.       IF(N.EQ.0) GO TO 1
  38.       ideb = kcolac(3)+1
  39.       DO 6 IEL=ideb,N
  40.       MRIGID=ITLAC(IEL)
  41.       if(mrigid.eq.0) go to 6
  42.       SEGACT MRIGID*MOD
  43.       ICHOLE=-ABS(ICHOLE)
  44.       SEGDES MRIGID
  45.   6   CONTINUE
  46.    1  CONTINUE
  47.    2  CONTINUE
  48. C ------MEME TRAVAIL POUR LES SUPER ELEMENTS--------------
  49.       ITLACC=KCOLA(23)
  50.       IF (ITLACC.LE.0) GO TO 20
  51.       N=ITLAC(/1)
  52.       IF(N.EQ.0) GO TO 10
  53.       DO 11 IEL=1,N
  54.       MSUPER=ITLAC(IEL)
  55.       if(msuper.eq.0) go to 11
  56.       SEGACT MSUPER
  57.       MRIGID=MRIGTO
  58.       SEGACT MRIGID*MOD
  59.       ICHOLE=-ABS(ICHOLE)
  60.       SEGDES MRIGID
  61.       MRIGID=MSURAI
  62.       SEGACT MRIGID*MOD
  63.       ICHOLE=-ABS(ICHOLE)
  64.       SEGDES MRIGID
  65.       MRIGID=MSUMAS
  66.       IF(MRIGID.NE.0) THEN
  67.          SEGACT MRIGID*MOD
  68.          ICHOLE=-ABS(ICHOLE)
  69.          SEGDES MRIGID
  70.       ENDIF
  71.       SEGDES MSUPER
  72.   11  CONTINUE
  73.   10  CONTINUE
  74.   20  CONTINUE
  75.       SEGDES ICOLAC
  76.       RETURN
  77.       END
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  

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