Télécharger la plaquette Cast3M


fr en

Télécharger clilis.eso

Retour à la liste

Numérotation des lignes : 

clilis

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

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