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