Télécharger extr37.eso

Retour à la liste

Numérotation des lignes :

extr37
  1. C EXTR37 SOURCE KICH 22/02/17 21:15:02 11282
  2. SUBROUTINE EXTR37(MCHELM,MLMOTS)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. *-----------------------------------------------------------------------
  6. *
  7. * E X T R 37
  8. * -----------
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. * EXTRAIT LES NOMS DES constituants D'UN MCHAML
  14. * ET LES RANGE DANS UN LISTMOTS MLMOTS
  15. * signale les constituants 'nombre'
  16. *
  17. * MODULES UTILISES:
  18. * -----------------
  19. *
  20. -INC SMCHAML
  21. -INC SMLMOTS
  22. *
  23. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  24. * -----------
  25. *
  26. * MCHELM (E) POINTEUR SUR LE MCHAML
  27. * MLMOTS (S) POINTEUR SUR LE LISTMOTS
  28. *
  29. *-----------------------------------------------------------------------
  30. *
  31. *
  32. PARAMETER (NCONCS=16)
  33.  
  34.  
  35. SEGACT MCHELM
  36. JGN=NCONCS
  37. JGM=0
  38. SEGINI MLMOTS
  39. IF (IMACHE(/1).EQ.0) GO TO 90
  40. *
  41. JGM = 1
  42. SEGADJ MLMOTS
  43. if (conche(1)(1:NCONCS).eq.' ') call erreur (-328)
  44. MOTS(JGM) = CONCHE(1)(1:NCONCS)
  45. *
  46. IF (IMACHE(/1).NE.1) THEN
  47. DO 40 K=2,IMACHE(/1)
  48. if (conche(k)(1:NCONCS).eq.' ') call erreur (-328)
  49. DO 50 J=1,JGM
  50. IF (MOTS(J).EQ.CONCHE(K)(1:NCONCS)) GOTO 40
  51. 50 CONTINUE
  52. JGM=JGM+1
  53. SEGADJ MLMOTS
  54. MOTS(JGM)=CONCHE(K)(1:NCONCS)
  55. 40 CONTINUE
  56. ENDIF
  57. *
  58. 90 SEGDES MLMOTS,MCHELM
  59. RETURN
  60. END
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  

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