Télécharger extr37.eso

Retour à la liste

Numérotation des lignes :

  1. C EXTR37 SOURCE PV 09/03/12 21:22:10 6325
  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. SEGACT MCHELM
  33. JGN=4
  34. JGM=0
  35. SEGINI MLMOTS
  36. IF (IMACHE(/1).EQ.0) GO TO 90
  37. *
  38. JGM = 1
  39. SEGADJ MLMOTS
  40. if (conche(1)(1:4).eq.' ') call erreur (-328)
  41. MOTS(JGM) = CONCHE(1)(1:4)
  42. *
  43. IF (IMACHE(/1).NE.1) THEN
  44. DO 40 K=2,IMACHE(/1)
  45. if (conche(k)(1:4).eq.' ') call erreur (-328)
  46. DO 50 J=1,JGM
  47. IF (MOTS(J).EQ.CONCHE(K)(1:4)) GOTO 40
  48. 50 CONTINUE
  49. JGM=JGM+1
  50. SEGADJ MLMOTS
  51. MOTS(JGM)=CONCHE(K)(1:4)
  52. 40 CONTINUE
  53. ENDIF
  54. *
  55. 90 SEGDES MLMOTS,MCHELM
  56. RETURN
  57. END
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  

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