Télécharger cpalis.eso

Retour à la liste

Numérotation des lignes :

  1. C CPALIS SOURCE PV 16/11/26 21:15:22 9205
  2. subroutine cpalis(argume,jcolac,nNod,bu,bufPos)
  3. C=======================================================================
  4. C Sous-programme cpalis (Collaborateur PAQuettage LIste)
  5. C Enregistre le message complet a envoyer dans le buffer bu a partir de
  6. C la position bufPos
  7. C Il faut s'assurer au prealabe que la taille du buffer est
  8. C suffisante,
  9. C=======================================================================
  10.  
  11. integer iPile
  12. integer iPoint,nNoeud
  13. integer nNod
  14. integer bufPos
  15. integer iArgu,nArg
  16. character*(8) typNom
  17. -INC CCOPTIO
  18. -INC TMCOLAC
  19. segment LISARG
  20. character*8 nom(nArg)
  21. integer adress(nArg)
  22. endsegment
  23. segment BUFFER
  24. character ffer(lonBuf)
  25. endsegment
  26. segment LISNOD
  27. integer liste(nNoeud)
  28. endsegment
  29. pointeur jcolac.ICOLAC
  30. pointeur lisNoe.ITLACC
  31. pointeur bu.BUFFER
  32. pointeur seg2pi.ILISSE
  33. pointeur argume.LISARG
  34. C Liste de passage de la numerotation actuelle vers la numerotation
  35. C de communication
  36. pointeur ac2co.LISNOD
  37. pointeur co2ac.LISNOD
  38. C write(ioimp,*) 'Entree dans CPALIS'
  39.  
  40. C nbPile=jcolac.kcola(/1)
  41. C lonBuf=bu.ffer(/2)
  42. co2ac=jcolac.kcola(32)
  43. nNoeud= nNod
  44. segini ac2co
  45. call clinin(co2ac,ac2co)
  46. nNoeud=co2ac.liste(/1)
  47. seg2pi = jcolac.ilissg
  48.  
  49. nArg=argume.adress(/1)
  50. C pour chaque argument
  51. do 3 iArgu =1,nArg
  52. C recuperer son type
  53. typNom = argume.nom(iArgu)
  54. C recuper le numero de pile associe
  55. call typfil (typNom,iPile)
  56. iPoint = argume.adress(iArgu)
  57. if(iimpi.ge.7) then
  58. write(ioimp,*) 'Paquettage d un objet',typNom, iPoint
  59. endif
  60. if(iPoint.eq.0) then
  61. if(iimpi.ge.7) then
  62. write(ioimp,*) 'Pointeur nul, passage a l objet suivant'
  63. endif
  64. goto 3
  65. endif
  66.  
  67. C Redirection vers le traitement correspondant au type de la pile
  68. c a toutes fins utiles, les etiquettes suivantes sont ranges par ligne de 10
  69. goto(
  70. & 0100, 0200, 0300, 0400, 0500, 0600, 0700, 0800, 0900, 1000,
  71. & 1100, 1200, 1300, 1400, 1500, 1600, 1700, 1800, 1900, 2000,
  72. & 2100, 2200, 2300, 2400, 2500, 2600, 2700, 2800, 2900, 3000,
  73. & 3100, 3200, 3300, 3400, 3500, 3600, 3700, 3800, 3900, 4000,
  74. & 4100, 4200, 4300, 4400, 4500, 4600, 4700), iPile
  75. goto 2
  76. c ******************** meleme ********************
  77. 0100 continue
  78. call cpamel(iPoint,ac2co,seg2pi,bu,bufPos)
  79. goto 1
  80. c ******************** chpoint ********************
  81. 0200 continue
  82. call cpacpo(iPoint,seg2pi,bu,bufPos)
  83. goto 1
  84. c ******************** mrigid ********************
  85. 0300 continue
  86. call cparig(iPoint,seg2pi,bu,bufPos)
  87. goto 1
  88. c ******************** ********************
  89. 0400 continue
  90. goto 1
  91. c ******************** ********************
  92. 0500 continue
  93. goto 1
  94. c ******************** bloq ********************
  95. 0600 continue
  96. goto 1
  97. c ******************** elem ********************
  98. 0700 continue
  99. goto 1
  100. c ******************** msolut ********************
  101. 0800 continue
  102. goto 1
  103. c ******************** mstruc ********************
  104. 0900 continue
  105. goto 1
  106. c ******************** mtable ********************
  107. 1000 continue
  108. goto 1
  109. c ******************** ********************
  110. 1100 continue
  111. goto 1
  112. c ******************** msostu ********************
  113. 1200 continue
  114. goto 1
  115. c ******************** imatri ********************
  116. 1300 continue
  117. goto 1
  118. c ******************** mjonct ********************
  119. 1400 continue
  120. goto 1
  121. c ******************** mattac ********************
  122. 1500 continue
  123. goto 1
  124. c ******************** mmatri ********************
  125. 1600 continue
  126. goto 1
  127. c ******************** mdefor ********************
  128. 1700 continue
  129. goto 1
  130. c ******************** mlreel ********************
  131. 1800 continue
  132. goto 1
  133. c ******************** mlenti ********************
  134. 1900 continue
  135. goto 1
  136. c ******************** mcharg ********************
  137. 2000 continue
  138. goto 1
  139. c ******************** ********************
  140. 2100 continue
  141. goto 1
  142. c ******************** mevoll ********************
  143. 2200 continue
  144. goto 1
  145. c ******************** superele ********************
  146. 2300 continue
  147. goto 1
  148. c ******************** logique ********************
  149. 2400 continue
  150. C call cpalog(pilLoc,iPoint,bu,bufPos)
  151. goto 1
  152. c ******************** flottant ********************
  153. 2500 continue
  154. C call cparee(pilLoc,iPoint,bu,bufPos)
  155. goto 1
  156. c ******************** entier ********************
  157. 2600 continue
  158. C call cpaent(iPoint,bu,bufPos)
  159. goto 1
  160. c ******************** mot ********************
  161. 2700 continue
  162. C call cpamot(pilLoc,iPoint,bu,bufPos)
  163. goto 1
  164. c ******************** texte ********************
  165. 2800 continue
  166. goto 1
  167. c ******************** listmots ********************
  168. 2900 continue
  169. goto 1
  170. c ******************** vecteur ********************
  171. 3000 continue
  172. goto 1
  173. c ******************** vectd ********************
  174. 3100 continue
  175. goto 1
  176. c ******************** point ********************
  177. 3200 continue
  178. call cpanod(iPoint,bu,bufPos)
  179. goto 1
  180. c ******************** config ********************
  181. 3300 continue
  182. call cpacfg(iPoint,co2ac,bu,bufPos)
  183. goto 1
  184. c ******************** mlchpo ********************
  185. 3400 continue
  186. goto 1
  187. c ******************** mbasem ********************
  188. 3500 continue
  189. goto 1
  190. c ******************** procedur ********************
  191. 3600 continue
  192. goto 1
  193. c ******************** bloc ********************
  194. 3700 continue
  195. goto 1
  196. c ******************** mmodel ********************
  197. 3800 continue
  198. call cpamod(iPoint,ac2co,seg2pi,bu,bufPos)
  199. goto 1
  200. c ******************** mchaml ********************
  201. 3900 continue
  202. call cpachm(iPoint,seg2pi,bu,bufPos)
  203. goto 1
  204. c ******************** minte ********************
  205. 4000 continue
  206. call cpamin(iPoint,bu,bufPos)
  207. goto 1
  208. c ******************** nuage ********************
  209. 4100 continue
  210. goto 1
  211. c ******************** matrak ********************
  212. 4200 continue
  213. goto 1
  214. c ******************** matrik ********************
  215. 4300 continue
  216. goto 1
  217. c ******************** objet ********************
  218. 4400 continue
  219. goto 1
  220. c ******************** methode ********************
  221. 4500 continue
  222. goto 1
  223. c ******************** esclave ********************
  224. 4600 continue
  225. goto 1
  226. c ******************** fantome ********************
  227. 4700 continue
  228. goto 1
  229. c **************************************************
  230. C Gestion des erreurs
  231. 2 continue
  232. write(ioimp,*) 'Probleme dans la pile',typNom, iPile
  233. moterr(1:8)=typNom
  234. call erreur (336)
  235. goto 3
  236. C Fin du case
  237. 1 continue
  238. C Mise a jour du compteur d elements envoyes
  239. if(iimpi.ge.7) then
  240. write(ioimp,*) 'Objet paquette'
  241. write(ioimp,*) 'Position du buffer',bufPos
  242. endif
  243. C Fin de la boucle sur les piles
  244. 3 continue
  245. segsup ac2co
  246. C write(ioimp,*) 'Sortie de CPALIS'
  247. end
  248.  
  249.  
  250.  
  251.  
  252.  

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