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

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