Télécharger la plaquette Cast3M


fr en

Télécharger sepa.eso

Retour à la liste

Numérotation des lignes : 

sepa

  1. C SEPA      SOURCE    FANDEUR   22/01/19    21:15:16     11256          
  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.  
  10.       SEGACT MRIGID
  11. c
  12.       NRIGE=IRIGEL(/1)
  13.       IF(NRIGE.LE.5) THEN
  14.         CALL ERREUR (5)
  15.       ENDIF
  16. c
  17.       NRIGEL=0
  18.       DO 1 I=1,IRIGEL(/2)
  19.         DESCR=IRIGEL(3,I)
  20.         SEGACT DESCR
  21.         DO 6 K=1,LISINC(/2)
  22.           IF(LISINC(K).EQ.'LX  ') GO TO 7
  23.    6    CONTINUE
  24.         GO TO 1
  25.    7    CONTINUE
  26.         NRIGEL=NRIGEL+1
  27.    1  CONTINUE
  28. c
  29.       IF (IRET.EQ.1) NRIGEL=IRIGEL(/2)-NRIGEL
  30. c
  31.       SEGINI RI1
  32.       RI1.MTYMAT=MTYMAT
  33.       RI1.IFORIG=IFORIG
  34. c
  35.       IF (NRIGEL.EQ.0) GOTO 9000
  36. c
  37.       IEL=0
  38.       DO 3 I=1,IRIGEL(/2)
  39.         DESCR=IRIGEL(3,I)
  40.         IMUL=1
  41. c
  42.         DO 11 K=1,LISINC(/2)
  43.           IF(LISINC(K).NE.'LX  ') GO TO 11
  44.           IMUL=2
  45.           GO TO 12
  46.    11   CONTINUE
  47. c
  48.    12   CONTINUE
  49.         IF (IMUL.EQ.IRET) THEN
  50.           IEL=IEL+1
  51.           RI1.COERIG(IEL)=COERIG(I)
  52.           DO J=1,NRIGE
  53.             RI1.IRIGEL(J,IEL)=IRIGEL(J,I)
  54.           ENDDO
  55.         ENDIF
  56.    3  CONTINUE
  57. c      if (iel.ne.nrigel) call erreur(5)
  58.  
  59.  9000 CONTINUE
  60.       DO I=1,IRIGEL(/2)
  61.         DESCR=IRIGEL(3,I)
  62.         SEGDES DESCR
  63.       ENDDO
  64. c
  65.       SEGDES MRIGID,RI1
  66.       MRIGID=RI1
  67. c*      RETURN
  68.       END
  69.  
  70.  
  71.  

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