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

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