Télécharger la plaquette Cast3M


fr en

Télécharger mots.eso

Retour à la liste

Numérotation des lignes : 

mots

  1. C MOTS      SOURCE    CB215821  21/11/25    21:15:11     11201          
  2.       SUBROUTINE MOTS
  3. ************************************************************************
  4. *
  5. *                               M O T S
  6. *                               -------
  7. *
  8. *            SOUS-PROGRAMME ASSOCIE A L'OPERATEUR "MOTS"
  9. *
  10. * FONCTION:
  11. * ---------
  12. *
  13. *     ENREGISTRER UN OBJET DE TYPE 'LISTMOTS'.
  14. *
  15. * PHRASE D'APPEL (EN GIBIANE):
  16. * ----------------------------
  17. *
  18. *     OBJET1 = MOTS MOT1 (MOT2 (MOT3 ...) ) ;
  19. *
  20. *     LES PARENTHESES INDIQUANT DES ARGUMENTS FACULTATIFS.
  21. *
  22. * ARGUMENTS (EN GIBIANE):
  23. * -----------------------
  24. *
  25. *     MOT1,              )  CHAINES DE CARACTERES QUELCONQUES NE
  26. *      MOT2,             )) CONTENANT NI BLANC, NI CARACTERE RESERVE
  27. *       MOT3, ...        )  (TEL LE SIGNE "=").
  28. *
  29. *     OBJET1    'LISTMOTS'  LISTE DE MOTS CREEE (tronques a LOCHAI caracteres).
  30. *
  31. * DICTIONNAIRE DES VARIABLES: (ORDRE ALPHABETIQUE)
  32. * ---------------------------
  33. *
  34. *     IPMOTS  ENTIER    POINTEUR SUR L'OBJET "OBJET1".
  35. *     LEMOT   ENTIER    CONTIENT L'UN DES MOTS "MOT1", MOT2", ...
  36. *
  37. * SOUS-PROGRAMMES APPELES:
  38. * ------------------------
  39. *
  40. *     LIRCHA, ECROBJ, ERREUR.
  41. *
  42. * REMARQUES:
  43. * ----------
  44. *
  45. *     L'APPEL AU SOUS-PROGRAMME "ERREUR" EST DU AU FAIT QUE LE
  46. *     SOUS-PROGRAMME "LIROBJ" NE FOURNIT PAS LE NOM DE L'OBJET, QUAND IL
  47. *     EN RECONNAIT UN, MAIS SIMPLEMENT SA VALEUR.
  48. *     OR, LA TABLE DES NOMS D'OBJETS NE PERMET PAS DE RETROUVER UN NOM
  49. *     CONNAISSANT UN POINTEUR (C-A-D UN OBJET) CAR PLUSIEURS NOMS
  50. *     PEUVENT AVOIR ETE ATTRIBUES A UN MEME OBJET.
  51. *     IL N'EST DONC PAS POSSIBLE DE RECUPERER LE NOM COMME UN SIMPLE
  52. *     MOT QUAND CE NOM EST UN NOM D'OBJET.
  53. *
  54. *     LA LECTURE D'UN ENTIER OU D'UN REEL COMME UN SIMPLE MOT NE
  55. *     FONCTIONNE PAS ACTUELLEMENT, MAIS CELA PEUT ETRE FAIT
  56. *     (MOYENNANT UN APPEL A UN SOUS-PROGRAMME ACCEPTANT DE COMMETTRE
  57. *     QUELQUES INDELICATESSES VIS-A-VIS DE LA NORME FORTRAN77).
  58. *
  59. *
  60. ************************************************************************
  61. *
  62.       IMPLICIT INTEGER(I-N)
  63. -INC SMLMOTS
  64. -INC PPARAM
  65. -INC CCOPTIO
  66. *
  67.       CHARACTER*4 MSPE(1)
  68.       DATA MSPE/'*   '/
  69.       CHARACTER*(LOCHAI) LEMOT
  70. *
  71.       PARAMETER (INFINI = 9999)
  72. *
  73. *
  74.       JGN   = LOCOMP
  75.       JGM   = 10
  76.       IPMOTS= 0
  77.       IMO   = 0
  78.       SEGINI,MLMOTS
  79.       IPMOTS=MLMOTS
  80. *
  81. *
  82. *     BOUCLE SUR LA LISTE D'OBJETS PASSES A L'OPERATEUR MOTS
  83. *     ----------------------------------------------------------------
  84.  100  CONTINUE
  85. *
  86. *         ON LIT UN EVENTUEL MOT-CLE DE REPETITION (*) ...
  87.           NFOIS=1
  88.           CALL LIRENT(NFOIS,0,IRET1)
  89. *
  90. *         ...PUIS ON CHERCHE UN NOUVEAU MOT
  91.           CALL LIRCHA(LEMOT,0,IRETOU)
  92. *
  93. *
  94. *      => PAS DE NOUVEAU MOT
  95.           IF (IRETOU.EQ.0) THEN
  96. *
  97. *             ERREUR, car on attendait le caractere special *
  98.               IF (IRET1.NE.0) GOTO 999
  99. *
  100. *             Sinon, on ajuste eventuellement le LISTMOTS et on sort
  101.               IF (IMO.NE.JGM) THEN
  102.                   JGM=IMO
  103.                   SEGADJ,MLMOTS
  104.               ENDIF
  105.               GOTO 110
  106. *
  107. *      => NOUVEAU MOT TROUVE
  108.           ELSE
  109.  
  110.             IF(IRETOU .GT. JGN)THEN
  111.               JGN = IRETOU
  112.               SEGADJ,MLMOTS
  113.             ENDIF
  114.  
  115.             IF (IRET1.NE.0) THEN
  116. *             ERREUR, car on attendait le caractere special *
  117.               IF (LEMOT.NE.MSPE(1)) GOTO 999
  118.               CALL LIRCHA(LEMOT,1,IRETOU)
  119.             ENDIF
  120. *
  121. *           Sinon, on complète le LISTMOTS
  122.             IMO=IMO+NFOIS
  123.             IF (IMO.GT.JGM) THEN
  124.                 JGM=IMO * 2 + 10
  125.                 SEGADJ,MLMOTS
  126.             ENDIF
  127.             DO JJ=1,NFOIS
  128.                 MOTS(IMO+JJ-NFOIS)=LEMOT
  129.             ENDDO
  130. *
  131.           END IF
  132.       GOTO 100
  133.  
  134. *     ----------------------------------------------------------------
  135. *
  136.  999  CONTINUE
  137.       MOTERR=MSPE(1)
  138.       CALL ERREUR(396)
  139.       RETURN
  140. *
  141. *
  142.  110  CONTINUE
  143.       SEGDES,MLMOTS
  144.       CALL ECROBJ ('LISTMOTS',IPMOTS)
  145.  
  146.       END
  147.  
  148.  
  149.  
  150.  
  151.  

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