Télécharger extr17.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR17 SOURCE CB215821 17/06/06 21:15:04 9448
  2. SUBROUTINE EXTR17(MCHELM,MLMOTS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C-----------------------------------------------------------------------
  6. C
  7. C E X T R 1 7
  8. C -----------
  9. C
  10. C FONCTION:
  11. C ---------
  12. C
  13. C EXTRAIT LES NOMS DES COMPOSANTES D'UN MCHAML
  14. C ET LES RANGE DANS UN LISTMOTS MLMOTS
  15. C
  16. C MODULES UTILISES:
  17. C -----------------
  18. C
  19. -INC SMCHAML
  20. -INC SMLMOTS
  21. C
  22. C PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  23. C -----------
  24. C
  25. C MCHELM (E) POINTEUR SUR LE MCHAML
  26. C MLMOTS (S) POINTEUR SUR LE LISTMOTS
  27. C
  28. C-----------------------------------------------------------------------
  29.  
  30. SEGACT,MCHELM
  31. JGN =4
  32. JGM =0
  33. INCJGM=10
  34. SEGINI MLMOTS
  35. N1=IMACHE(/1)
  36.  
  37. IF (N1.EQ.0) GOTO 90
  38.  
  39. DO 10 I=1,N1
  40. MCHAML=ICHAML(I)
  41. SEGACT,MCHAML
  42. 10 CONTINUE
  43.  
  44. MCHAML=ICHAML(1)
  45. JGM=NOMCHE(/2)
  46. SEGADJ,MLMOTS
  47. DO 20 I=1,JGM
  48. MOTS(I)=NOMCHE(I)(1:4)
  49. 20 CONTINUE
  50. SEGDES,MCHAML
  51.  
  52. NBCOMP=JGM
  53. IF (N1.GT.1) THEN
  54. DO 30 I=2,N1
  55. MCHAML=ICHAML(I)
  56. DO 40 K=1,NOMCHE(/2)
  57. DO 50 J=1,NBCOMP
  58. IF (MOTS(J).EQ.NOMCHE(K)(1:4)) GOTO 40
  59. 50 CONTINUE
  60. NBCOMP = NBCOMP + 1
  61. IF (NBCOMP .GT. JGM)THEN
  62. JGM=JGM+INCJGM
  63. INCJGM = INCJGM * 2
  64. SEGADJ,MLMOTS
  65. ENDIF
  66. MOTS(NBCOMP)=NOMCHE(K)(1:4)
  67. 40 CONTINUE
  68. SEGDES MCHAML
  69. 30 CONTINUE
  70. ENDIF
  71.  
  72. IF (NBCOMP .NE. JGM)THEN
  73. JGM=NBCOMP
  74. SEGADJ,MLMOTS
  75. ENDIF
  76. C
  77. 90 SEGDES MLMOTS,MCHELM
  78. RETURN
  79. END
  80.  
  81.  
  82.  

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