Télécharger extr11.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR11 SOURCE CHAT 05/01/12 23:51:48 5004
  2. SUBROUTINE EXTR11(ICHP,MLMOTS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *-----------------------------------------------------------------------
  6. *
  7. * E X T R 1 1
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * EXTRAIT LES COMPOSANTES DU CHPOINT "ICHP" ET LES RANGE DANS
  14. * UN LISTMOTS MLMOTS
  15. *
  16. * MODULES UTILISES:
  17. * -----------------
  18. *
  19. -INC SMCHPOI
  20. -INC SMLMOTS
  21. *
  22. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  23. * -----------
  24. *
  25. * ICHP (E) POINTEUR SUR LE CHPOINT
  26. * MLMOTS (S) POINTEUR SUR LE LISTMOTS
  27. *
  28. *-----------------------------------------------------------------------
  29. *
  30. *
  31. JGN=4
  32. MCHPOI = ICHP
  33. SEGACT MCHPOI
  34. JGM=0
  35. SEGINI MLMOTS
  36. IF (IPCHP(/1).EQ.0) GO TO 90
  37. DO 10 I=1,IPCHP(/1)
  38. MSOUPO=IPCHP(I)
  39. SEGACT MSOUPO
  40. 10 CONTINUE
  41. *
  42. MSOUPO=IPCHP(1)
  43. JGM=NOCOMP(/2)
  44. SEGADJ MLMOTS
  45. DO 20 I=1,JGM
  46. MOTS(I)=NOCOMP(I)
  47. 20 CONTINUE
  48. SEGDES MSOUPO
  49. *
  50. IF (IPCHP(/1).NE.1) THEN
  51. DO 30 I=2,IPCHP(/1)
  52. MSOUPO=IPCHP(I)
  53. DO 40 K=1,NOCOMP(/2)
  54. DO 50 J=1,JGM
  55. IF (MOTS(J).EQ.NOCOMP(K)) GOTO 40
  56. 50 CONTINUE
  57. JGM=JGM+1
  58. SEGADJ MLMOTS
  59. MOTS(JGM)=NOCOMP(K)
  60. 40 CONTINUE
  61. SEGDES MSOUPO
  62. 30 CONTINUE
  63. ENDIF
  64. *
  65. 90 SEGDES MLMOTS,MCHPOI
  66. RETURN
  67. END
  68.  
  69.  

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