Télécharger clilis.eso

Retour à la liste

Numérotation des lignes :

  1. C CLILIS SOURCE GF238795 18/01/22 21:15:00 9702
  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. c iPoint=pile.itlac(iPoPi)
  44. c on deplace la recuperation de la valeur du pointeur dans le
  45. c switch pour eviter de planter en accedant a des piles non gerees
  46. * if(iPoint.eq.0) then
  47. * if(iimpi.ge.7) then
  48. * write(ioimp,*) 'Pointeur de segment incorrect'
  49. * endif
  50. * goto 2
  51. * endif
  52.  
  53.  
  54. C Redirection vers le traitement correspondant au type de la pile
  55. c a toutes fins utiles, les etiquettes suivantes sont ranges par ligne de 10
  56. goto(
  57. & 0100, 0200, 0300, 0400, 0500, 0600, 0700, 0800, 0900, 1000,
  58. & 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000,
  59. & 2100, 2200, 2300, 2400, 2500, 2600, 2700, 2800, 2900, 3000,
  60. & 3100, 3200, 3300, 3400, 3500, 3600, 3700, 3800, 3900, 4000,
  61. & 4100, 4200, 4300, 4400, 4500, 4600, 4700), iPile
  62. goto 2
  63. c ******************** meleme ********************
  64. 0100 continue
  65. iPoint=pile.itlac(iPoPi)
  66. call climel(iPoint,jcolac)
  67. goto 1
  68. c ******************** chpoint ********************
  69. 0200 continue
  70. iPoint=pile.itlac(iPoPi)
  71. call clicpo(iPoint,jcolac)
  72. goto 1
  73. c ******************** mrigid ********************
  74. 0300 continue
  75. iPoint=pile.itlac(iPoPi)
  76. call clirig(iPoint,jcolac)
  77. goto 1
  78. c ******************** ********************
  79. 0400 continue
  80. goto 1
  81. c ******************** ********************
  82. 0500 continue
  83. goto 1
  84. c ******************** bloq ********************
  85. 0600 continue
  86. goto 1
  87. c ******************** elem ********************
  88. 0700 continue
  89. goto 1
  90. c ******************** msolut ********************
  91. 0800 continue
  92. goto 1
  93. c ******************** mstruc ********************
  94. 0900 continue
  95. goto 1
  96. c ******************** mtable ********************
  97. 1000 continue
  98. goto 1
  99. c ******************** ********************
  100. 1100 continue
  101. goto 1
  102. c ******************** msostu ********************
  103. 1200 continue
  104. goto 1
  105. c ******************** imatri ********************
  106. 1300 continue
  107. goto 1
  108. c ******************** mjonct ********************
  109. 1400 continue
  110. goto 1
  111. c ******************** mattac ********************
  112. 1500 continue
  113. goto 1
  114. c ******************** mmatri ********************
  115. 1600 continue
  116. goto 1
  117. c ******************** mdefor ********************
  118. 1700 continue
  119. goto 1
  120. c ******************** mlreel ********************
  121. 1800 continue
  122. goto 1
  123. c ******************** mlenti ********************
  124. 1900 continue
  125. goto 1
  126. c ******************** mcharg ********************
  127. 2000 continue
  128. goto 1
  129. c ******************** ********************
  130. 2100 continue
  131. goto 1
  132. c ******************** mevoll ********************
  133. 2200 continue
  134. goto 1
  135. c ******************** superele ********************
  136. 2300 continue
  137. goto 1
  138. c ******************** logique ********************
  139. 2400 continue
  140. goto 1
  141. c ******************** flottant ********************
  142. 2500 continue
  143. goto 1
  144. c ******************** entier ********************
  145. 2600 continue
  146. goto 1
  147. c ******************** mot ********************
  148. 2700 continue
  149. goto 1
  150. c ******************** texte ********************
  151. 2800 continue
  152. goto 1
  153. c ******************** listmots ********************
  154. 2900 continue
  155. goto 1
  156. c ******************** vecteur ********************
  157. 3000 continue
  158. goto 1
  159. c ******************** vectd ********************
  160. 3100 continue
  161. goto 1
  162. c ******************** point ********************
  163. 3200 continue
  164. goto 1
  165. c ******************** config ********************
  166. 3300 continue
  167. iPoint=pile.itlac(iPoPi)
  168. call clicfg(iPoint,jcolac)
  169. goto 1
  170. c ******************** mlchpo ********************
  171. 3400 continue
  172. goto 1
  173. c ******************** mbasem ********************
  174. 3500 continue
  175. goto 1
  176. c ******************** procedur ********************
  177. 3600 continue
  178. goto 1
  179. c ******************** bloc ********************
  180. 3700 continue
  181. goto 1
  182. c ******************** mmodel ********************
  183. 3800 continue
  184. iPoint=pile.itlac(iPoPi)
  185. call climod(iPoint,jcolac)
  186. goto 1
  187. c ******************** mchaml ********************
  188. 3900 continue
  189. iPoint=pile.itlac(iPoPi)
  190. call clichm(iPoint,jcolac)
  191. goto 1
  192. c ******************** minte ********************
  193. 4000 continue
  194. C write(ioimp,*) 'Recollage des mintes: Rien a faire'
  195. goto 1
  196. c ******************** nuage ********************
  197. 4100 continue
  198. goto 1
  199. c ******************** matrak ********************
  200. 4200 continue
  201. goto 1
  202. c ******************** matrik ********************
  203. 4300 continue
  204. goto 1
  205. c ******************** objet ********************
  206. 4400 continue
  207. goto 1
  208. c ******************** methode ********************
  209. 4500 continue
  210. goto 1
  211. c ******************** esclave ********************
  212. 4600 continue
  213. goto 1
  214. c ******************** fantome ********************
  215. 4700 continue
  216. goto 1
  217. c **************************************************
  218. C Gestion des erreurs
  219. 2 continue
  220. write(ioimp,*) 'Probleme dans la pile',typNom, iPile
  221. moterr(1:8)=typNom
  222. call erreur (336)
  223. goto 1
  224. C Fin du case
  225. 1 continue
  226. if(iimpi.ge.7) then
  227. write(ioimp,*) 'Objet recolle.'
  228. endif
  229.  
  230. C Fin de la boucle sur les piles
  231. 3 continue
  232. C write(ioimp,*) 'Sortie de CLILIS'
  233. end
  234.  
  235.  
  236.  
  237.  
  238.  
  239.  

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