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 PPARAM
  74. -INC CCOPTIO
  75. *
  76. CHARACTER*4 MSPE(1)
  77. DATA MSPE/'* '/
  78. CHARACTER*(4) LEMOT
  79. *
  80. PARAMETER (INFINI = 9999)
  81. *
  82. *
  83. JGN=4
  84. JGM=10
  85. SEGINI,MLMOTS
  86. IPMOTS=MLMOTS
  87. IMO=0
  88. *
  89. *
  90. * BOUCLE SUR LA LISTE D'OBJETS PASSES A L'OPERATEUR MOTS
  91. * ----------------------------------------------------------------
  92. DO 100 IB100=1,INFINI
  93. *
  94. * ON LIT UN EVENTUEL MOT-CLE DE REPETITION (*) ...
  95. NFOIS=1
  96. CALL LIRENT(NFOIS,0,IRET1)
  97. *
  98. * ...PUIS ON CHERCHE UN NOUVEAU MOT
  99. CALL LIRCHA(LEMOT,0,IRETOU)
  100. *
  101. *
  102. * => PAS DE NOUVEAU MOT
  103. IF (IRETOU.EQ.0) THEN
  104. *
  105. * ERREUR, car on attendait le caractere special *
  106. IF (IRET1.NE.0) GOTO 999
  107. *
  108. * Sinon, on ajuste eventuellement le LISTMOTS et on sort
  109. IF (IMO.NE.JGM) THEN
  110. JGM=IMO
  111. SEGADJ MLMOTS
  112. ENDIF
  113. GOTO 110
  114. *
  115. * => NOUVEAU MOT TROUVE
  116. ELSE
  117. *
  118. IF (IRET1.NE.0) THEN
  119. * ERREUR, car on attendait le caractere special *
  120. IF (LEMOT.NE.MSPE(1)) GOTO 999
  121. CALL LIRCHA(LEMOT,1,IRETOU)
  122. ENDIF
  123. *
  124. * Sinon, on complète le LISTMOTS
  125. IMO=IMO+NFOIS
  126. IF (IMO.GT.JGM) THEN
  127. JGM=IMO+10
  128. SEGADJ MLMOTS
  129. ENDIF
  130. DO JJ=1,NFOIS
  131. MOTS(IMO+JJ-NFOIS)=LEMOT
  132. ENDDO
  133. *
  134. END IF
  135. 100 CONTINUE
  136. * END DO
  137. GOTO 110
  138. * ----------------------------------------------------------------
  139. *
  140. *
  141. 999 CONTINUE
  142. MOTERR(1:4)=MSPE(1)
  143. CALL ERREUR(396)
  144. RETURN
  145. *
  146. *
  147. 110 CONTINUE
  148. SEGDES,MLMOTS
  149. CALL ECROBJ ('LISTMOTS',IPMOTS)
  150. *
  151. END
  152.  
  153.  
  154.  

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