Télécharger clilis.eso

Retour à la liste

Numérotation des lignes :

  1. C CLILIS SOURCE PV 16/11/26 21:15:13 9205
  2. subroutine clilis(argume,jcolac)
  3. C=======================================================================
  4. C Sous-programme clilis (COLlaborateur LIEr Liste)
  5. C Lie les objets recus a leur pointeur Esope
  6. C=======================================================================
  7. integer iPile,iPoPi
  8. integer iPoint
  9. integer iargu,narg
  10. character*(8) typNom
  11.  
  12. -INC CCOPTIO
  13. -INC TMCOLAC
  14. segment LISARG
  15. character*8 nom(nArg)
  16. integer adress(nArg)
  17. endsegment
  18. pointeur argume.LISARG
  19. pointeur jcolac.ICOLAC
  20. pointeur pile.ITLACC
  21.  
  22. C write(ioimp,*) 'Entree dans CLILIS'
  23.  
  24. nArg=argume.adress(/1)
  25. do 3 iArgu =1,nArg
  26. C recuperer son type
  27. typNom = argume.nom(iArgu)
  28. C recuper le numero de pile associe
  29. call typfil (typNom,iPile)
  30. pile=jcolac.kcola(iPile)
  31. iPoPi = argume.adress(iArgu)
  32. if(iimpi.ge.7) then
  33. write(ioimp,*) 'Recollage d un objet',typNom, iPoPi
  34. endif
  35. if(iPile.ge.24.and.iPile.le.27) goto 3
  36. if(iPoPi.eq.0) then
  37. if(iimpi.ge.7) then
  38. write(ioimp,*) 'Position dans la pile incorrecte'
  39. write(ioimp,*) 'Passage a l objet suivant'
  40. endif
  41. goto 3
  42. endif
  43. iPoint=pile.itlac(iPoPi)
  44. if(iPoint.eq.0) then
  45. if(iimpi.ge.7) then
  46. write(ioimp,*) 'Pointeur de segment incorrect'
  47. endif
  48. goto 2
  49. endif
  50.  
  51.  
  52. C Redirection vers le traitement correspondant au type de la pile
  53. c a toutes fins utiles, les etiquettes suivantes sont ranges par ligne de 10
  54. goto(
  55. & 0100, 0200, 0300, 0400, 0500, 0600, 0700, 0800, 0900, 1000,
  56. & 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000,
  57. & 2100, 2200, 2300, 2400, 2500, 2600, 2700, 2800, 2900, 3000,
  58. & 3100, 3200, 3300, 3400, 3500, 3600, 3700, 3800, 3900, 4000,
  59. & 4100, 4200, 4300, 4400, 4500, 4600, 4700), iPile
  60. goto 2
  61. c ******************** meleme ********************
  62. 0100 continue
  63. call climel(iPoint,jcolac)
  64. goto 1
  65. c ******************** chpoint ********************
  66. 0200 continue
  67. call clicpo(iPoint,jcolac)
  68. goto 1
  69. c ******************** mrigid ********************
  70. 0300 continue
  71. call clirig(iPoint,jcolac)
  72. goto 1
  73. c ******************** ********************
  74. 0400 continue
  75. goto 1
  76. c ******************** ********************
  77. 0500 continue
  78. goto 1
  79. c ******************** bloq ********************
  80. 0600 continue
  81. goto 1
  82. c ******************** elem ********************
  83. 0700 continue
  84. goto 1
  85. c ******************** msolut ********************
  86. 0800 continue
  87. goto 1
  88. c ******************** mstruc ********************
  89. 0900 continue
  90. goto 1
  91. c ******************** mtable ********************
  92. 1000 continue
  93. goto 1
  94. c ******************** ********************
  95. 1100 continue
  96. goto 1
  97. c ******************** msostu ********************
  98. 1200 continue
  99. goto 1
  100. c ******************** imatri ********************
  101. 1300 continue
  102. goto 1
  103. c ******************** mjonct ********************
  104. 1400 continue
  105. goto 1
  106. c ******************** mattac ********************
  107. 1500 continue
  108. goto 1
  109. c ******************** mmatri ********************
  110. 1600 continue
  111. goto 1
  112. c ******************** mdefor ********************
  113. 1700 continue
  114. goto 1
  115. c ******************** mlreel ********************
  116. 1800 continue
  117. goto 1
  118. c ******************** mlenti ********************
  119. 1900 continue
  120. goto 1
  121. c ******************** mcharg ********************
  122. 2000 continue
  123. goto 1
  124. c ******************** ********************
  125. 2100 continue
  126. goto 1
  127. c ******************** mevoll ********************
  128. 2200 continue
  129. goto 1
  130. c ******************** superele ********************
  131. 2300 continue
  132. goto 1
  133. c ******************** logique ********************
  134. 2400 continue
  135. goto 1
  136. c ******************** flottant ********************
  137. 2500 continue
  138. goto 1
  139. c ******************** entier ********************
  140. 2600 continue
  141. goto 1
  142. c ******************** mot ********************
  143. 2700 continue
  144. goto 1
  145. c ******************** texte ********************
  146. 2800 continue
  147. goto 1
  148. c ******************** listmots ********************
  149. 2900 continue
  150. goto 1
  151. c ******************** vecteur ********************
  152. 3000 continue
  153. goto 1
  154. c ******************** vectd ********************
  155. 3100 continue
  156. goto 1
  157. c ******************** point ********************
  158. 3200 continue
  159. goto 1
  160. c ******************** config ********************
  161. 3300 continue
  162. call clicfg(iPoint,jcolac)
  163. goto 1
  164. c ******************** mlchpo ********************
  165. 3400 continue
  166. goto 1
  167. c ******************** mbasem ********************
  168. 3500 continue
  169. goto 1
  170. c ******************** procedur ********************
  171. 3600 continue
  172. goto 1
  173. c ******************** bloc ********************
  174. 3700 continue
  175. goto 1
  176. c ******************** mmodel ********************
  177. 3800 continue
  178. call climod(iPoint,jcolac)
  179. goto 1
  180. c ******************** mchaml ********************
  181. 3900 continue
  182. call clichm(iPoint,jcolac)
  183. goto 1
  184. c ******************** minte ********************
  185. 4000 continue
  186. C write(ioimp,*) 'Recollage des mintes: Rien a faire'
  187. goto 1
  188. c ******************** nuage ********************
  189. 4100 continue
  190. goto 1
  191. c ******************** matrak ********************
  192. 4200 continue
  193. goto 1
  194. c ******************** matrik ********************
  195. 4300 continue
  196. goto 1
  197. c ******************** objet ********************
  198. 4400 continue
  199. goto 1
  200. c ******************** methode ********************
  201. 4500 continue
  202. goto 1
  203. c ******************** esclave ********************
  204. 4600 continue
  205. goto 1
  206. c ******************** fantome ********************
  207. 4700 continue
  208. goto 1
  209. c **************************************************
  210. C Gestion des erreurs
  211. 2 continue
  212. write(ioimp,*) 'Probleme dans la pile',typNom, iPile
  213. moterr(1:8)=typNom
  214. call erreur (336)
  215. goto 1
  216. C Fin du case
  217. 1 continue
  218. if(iimpi.ge.7) then
  219. write(ioimp,*) 'Objet recolle.'
  220. endif
  221.  
  222. C Fin de la boucle sur les piles
  223. 3 continue
  224. C write(ioimp,*) 'Sortie de CLILIS'
  225. end
  226.  
  227.  
  228.  
  229.  

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