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