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