Télécharger mots.eso

Retour à la liste

Numérotation des lignes :

  1. C MOTS SOURCE JC220346 12/05/16 21:15:06 7375
  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 4 CARACTERES QUELCONQUES NE
  26. * MOT2, )) CONTENANT NI BLANC, NI CARACTERE RESERVE
  27. * MOT3, ... ) (TEL LE SIGNE "=").
  28. *
  29. * OBJET1 'LISTMOTS' LISTE DE MOTS CREEE.
  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. * AUTEUR, DATE DE CREATION:
  60. * -------------------------
  61. *
  62. * PASCAL MANIGOT 22 OCTOBRE 1984
  63. *
  64. * LANGAGE:
  65. * --------
  66. *
  67. * ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  68. *
  69. ************************************************************************
  70. *
  71. IMPLICIT INTEGER(I-N)
  72. -INC SMLMOTS
  73. -INC CCOPTIO
  74. *
  75. CHARACTER*4 MSPE(1)
  76. DATA MSPE/'* '/
  77. CHARACTER*(4) LEMOT
  78. *
  79. PARAMETER (INFINI = 9999)
  80. *
  81. *
  82. JGN=4
  83. JGM=10
  84. SEGINI,MLMOTS
  85. IPMOTS=MLMOTS
  86. IMO=0
  87. *
  88. *
  89. * BOUCLE SUR LA LISTE D'OBJETS PASSES A L'OPERATEUR MOTS
  90. * ----------------------------------------------------------------
  91. DO 100 IB100=1,INFINI
  92. *
  93. * ON LIT UN EVENTUEL MOT-CLE DE REPETITION (*) ...
  94. NFOIS=1
  95. CALL LIRENT(NFOIS,0,IRET1)
  96. *
  97. * ...PUIS ON CHERCHE UN NOUVEAU MOT
  98. CALL LIRCHA(LEMOT,0,IRETOU)
  99. *
  100. *
  101. * => PAS DE NOUVEAU MOT
  102. IF (IRETOU.EQ.0) THEN
  103. *
  104. * ERREUR, car on attendait le caractere special *
  105. IF (IRET1.NE.0) GOTO 999
  106. *
  107. * Sinon, on ajuste eventuellement le LISTMOTS et on sort
  108. IF (IMO.NE.JGM) THEN
  109. JGM=IMO
  110. SEGADJ MLMOTS
  111. ENDIF
  112. GOTO 110
  113. *
  114. * => NOUVEAU MOT TROUVE
  115. ELSE
  116. *
  117. IF (IRET1.NE.0) THEN
  118. * ERREUR, car on attendait le caractere special *
  119. IF (LEMOT.NE.MSPE(1)) GOTO 999
  120. CALL LIRCHA(LEMOT,1,IRETOU)
  121. ENDIF
  122. *
  123. * Sinon, on complète le LISTMOTS
  124. IMO=IMO+NFOIS
  125. IF (IMO.GT.JGM) THEN
  126. JGM=IMO+10
  127. SEGADJ MLMOTS
  128. ENDIF
  129. DO JJ=1,NFOIS
  130. MOTS(IMO+JJ-NFOIS)=LEMOT
  131. ENDDO
  132. *
  133. END IF
  134. 100 CONTINUE
  135. * END DO
  136. GOTO 110
  137. * ----------------------------------------------------------------
  138. *
  139. *
  140. 999 CONTINUE
  141. MOTERR(1:4)=MSPE(1)
  142. CALL ERREUR(396)
  143. RETURN
  144. *
  145. *
  146. 110 CONTINUE
  147. SEGDES,MLMOTS
  148. CALL ECROBJ ('LISTMOTS',IPMOTS)
  149. *
  150. END
  151.  
  152.  
  153.  

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