Télécharger extr17.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR17 SOURCE CB215821 19/08/20 21:17:32 10287
  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.  
  51. NBCOMP=JGM
  52. IF (N1.GT.1) THEN
  53. DO 30 I=2,N1
  54. MCHAML=ICHAML(I)
  55. DO 40 K=1,NOMCHE(/2)
  56. DO 50 J=1,NBCOMP
  57. IF (MOTS(J).EQ.NOMCHE(K)(1:4)) GOTO 40
  58. 50 CONTINUE
  59. NBCOMP = NBCOMP + 1
  60. IF (NBCOMP .GT. JGM)THEN
  61. JGM=JGM+INCJGM
  62. INCJGM = INCJGM * 2
  63. SEGADJ,MLMOTS
  64. ENDIF
  65. MOTS(NBCOMP)=NOMCHE(K)(1:4)
  66. 40 CONTINUE
  67. 30 CONTINUE
  68. ENDIF
  69.  
  70. IF (NBCOMP .NE. JGM)THEN
  71. JGM=NBCOMP
  72. SEGADJ,MLMOTS
  73. ENDIF
  74. C
  75. 90 RETURN
  76. END
  77.  
  78.  
  79.  
  80.  

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