Télécharger la plaquette Cast3M


fr en

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