Télécharger la plaquette Cast3M


fr en

Télécharger sepa.eso

Retour à la liste

Numérotation des lignes : 

  1. C SEPA      SOURCE    CHAT      09/10/09    21:24:14     6519
  2.       SUBROUTINE SEPA(MRIGID,IRET)
  3. *
  4. *  EXTRAI DE MRIGID LA PARTIE SANS MULTIPLICATEUR SI IRET=1
  5. *  EXTRAI DE MRIGID LA PARTIE AVEC MULTIPLICATEUR SI IRET=2
  6. *
  7.       IMPLICIT INTEGER(I-N)
  8. -INC SMRIGID
  9.       SEGACT MRIGID
  10.       NRIGEL=0
  11.       NRIGE=IRIGEL(/1)
  12. c
  13.       IF(NRIGE.LE.5) THEN
  14.         CALL ERREUR (5)
  15.       ENDIF
  16. c
  17.       DO 1 I=1,IRIGEL(/2)
  18.         DESCR=IRIGEL(3,I)
  19.         SEGACT DESCR
  20.         DO 6 K=1,LISINC(/2)
  21.           IF(LISINC(K).EQ.'LX  ') GO TO 7
  22.    6    CONTINUE
  23.         GO TO 15
  24.    7    CONTINUE
  25.         NRIGEL=NRIGEL+1
  26.   15    SEGDES DESCR
  27.    1  CONTINUE
  28. c
  29.       IF(IRET.EQ.1) NRIGEL=IRIGEL(/2)-NRIGEL
  30. c
  31.       SEGINI RI1
  32.       RI1.MTYMAT=MTYMAT
  33. c
  34.       IF(NRIGEL.EQ.0) THEN
  35.          SEGDES RI1,MRIGID
  36.          MRIGID=RI1
  37.          RETURN
  38.       ENDIF
  39. c
  40.       IEL=0
  41.       DO 3 I=1,IRIGEL(/2)
  42.         DESCR=IRIGEL(3,I)
  43.         SEGACT DESCR
  44.         IMUL=1
  45. c
  46.         DO 11 K=1,LISINC(/2)
  47.           IF(LISINC(K).NE.'LX  ') GO TO 11
  48.           IMUL=2
  49.           GO TO 12
  50.    11   CONTINUE
  51. c
  52.    12   CONTINUE
  53.         IF(IMUL.NE.IRET) GO TO 4
  54.         IEL=IEL+1
  55. c
  56.         DO 2 J=1,NRIGE
  57.             RI1.IRIGEL(J,IEL)=IRIGEL(J,I)
  58.    2    CONTINUE
  59. c
  60.         RI1.COERIG(IEL)=COERIG(I)
  61.    4    CONTINUE
  62.         SEGDES DESCR
  63.    3  CONTINUE
  64. c
  65.       SEGDES MRIGID,RI1
  66.       MRIGID=RI1
  67.       RETURN
  68.       END
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  

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