Télécharger la plaquette Cast3M


fr en

Télécharger cpalis.eso

Retour à la liste

Numérotation des lignes : 

cpalis

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

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