Télécharger la plaquette Cast3M


fr en

Télécharger cmelis.eso

Retour à la liste

Numérotation des lignes : 

cmelis

  1. C CMELIS    SOURCE    PV        17/12/05    21:15:26     9646           
  2.       subroutine cmelis(argume,jcolac,taiTot)
  3. C=======================================================================
  4. C  Sous-programme cmelis (Collaborateur MESure LIste)
  5. C  Mesure de la taille du message a envoyer pour allouer le buffer
  6. C  On va parcourir tous les objets dans la liste, compter le
  7. C  nombre d'entiers, de flottants et de caracteres total puis calculer
  8. C  la taille du message MPI
  9. C=======================================================================
  10.       integer nbInt,nbFloa,nbChar
  11.       integer nbInTo,nbFlTo,nbChTo
  12.       integer taiTot,taille
  13.       integer iPile
  14.       integer iPoint,nNoeud
  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.       pointeur argume.LISARG
  26.       pointeur jcolac.ICOLAC
  27.       pointeur pile.ITLACC
  28. C      write(ioimp,*) 'Entree dans CMESLI'
  29.  
  30.       iPile=32
  31.       pile=jcolac.kcola(iPile)
  32.       nNoeud=pile.itlac(/1)
  33.       nArg = argume.adress(/1)
  34.       nbInTo=nArg+1
  35.       nbFlTo=0
  36.       nbChTo=0
  37. C pour chaque argument
  38.       do 3 iArgu =1,nArg
  39. C        recuperer son type
  40.          typNom = argume.nom(iArgu)
  41. C        recuper le numero de pile associe
  42.          call typfil (typNom,iPile)
  43.          iPoint =  argume.adress(iArgu)
  44.          if(iimpi.ge.7) then
  45.             write(ioimp,*) 'Mesure d''un objet',typNom, iPoint
  46.          endif
  47.          if(iPoint.eq.0) then
  48.             if(iimpi.ge.7) then
  49.                write(ioimp,*) 'Pointeur nul, passage a l''objet suivant'
  50.             endif
  51.             goto    3
  52.          endif
  53.          nbInt=0
  54.          nbFloa=0
  55.          nbChar=0
  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. 2        write(ioimp,*) 'Probleme dans la pile',typNom, iPile
  65.          moterr(1:8)=typNom
  66.          call erreur (336)
  67.          goto 1
  68. c     ******************** meleme ********************
  69. 0100     continue
  70.             call cmemel(iPoint,nbInt,nbFloa,nbChar)
  71.             nbInTo=nbInTo+nbInt
  72.             nbFlTo=nbFlTo+nbFloa
  73.             nbChTo=nbChTo+nbChar
  74.          goto 1
  75. c     ******************** chpoint  ********************
  76. 0200     continue
  77.             call cmecpo(iPoint,nbInt,nbFloa,nbChar)
  78.             nbInTo=nbInTo+nbInt
  79.             nbFlTo=nbFlTo+nbFloa
  80.             nbChTo=nbChTo+nbChar
  81.          goto 1
  82. c     ******************** mrigid   ********************
  83. 0300     continue
  84.             call cmerig(iPoint,nbInt,nbFloa,nbChar)
  85.             nbInTo=nbInTo+nbInt
  86.             nbFlTo=nbFlTo+nbFloa
  87.             nbChTo=nbChTo+nbChar
  88.          goto 1
  89. c     ********************          ********************
  90. 0400     continue
  91. C        Type d'objet non supporte, sortie en erreur
  92.          goto 2
  93. c     ********************          ********************
  94. 0500     continue
  95. C        Type d'objet non supporte, sortie en erreur
  96.          goto 2
  97. c     ******************** bloq     ********************
  98. 0600     continue
  99. C Type d'objet non supporte, sortie en erreur
  100.          goto 2
  101. c     ******************** elem     ********************
  102. 0700     continue
  103. C Type d'objet non supporte, sortie en erreur
  104.          goto 2
  105. c     ******************** msolut   ********************
  106. 0800     continue
  107. C Type d'objet non supporte, sortie en erreur
  108.          goto 2
  109. c     ******************** mstruc   ********************
  110. 0900     continue
  111. C Type d'objet non supporte, sortie en erreur
  112.          goto 2
  113. c     ******************** mtable   ********************
  114. 1000     continue
  115.             write(ioimp,*) 'On ne sait pas encore envoyer
  116.      &d''objet TABLE'
  117. C Type d'objet non supporte, sortie en erreur
  118.          goto 2
  119. c     ********************          ********************
  120. 1100     continue
  121. C Type d'objet non supporte, sortie en erreur
  122.          goto 2
  123. c     ******************** msostu   ********************
  124. 1200     continue
  125. C Type d'objet non supporte, sortie en erreur
  126.          goto 2
  127. c     ******************** imatri   ********************
  128. 1300     continue
  129.             write(ioimp,*) 'On ne veut pas envoyer d''objet IMATRI'
  130. C Type d'objet non supporte, sortie en erreur
  131.          goto 2
  132. c     ******************** mjonct   ********************
  133. 1400     continue
  134. C Type d'objet non supporte, sortie en erreur
  135.          goto 2
  136. c     ******************** mattac   ********************
  137. 1500     continue
  138. C Type d'objet non supporte, sortie en erreur
  139.          goto 2
  140. c     ******************** mmatri   ********************
  141. 1600     continue
  142.             write(ioimp,*) 'On ne veut pas envoyer d''objet MMATRI'
  143. C Type d'objet non supporte, sortie en erreur
  144.          goto 2
  145. c     ******************** mdefor   ********************
  146. 1700     continue
  147. C Type d'objet non supporte, sortie en erreur
  148.          goto 2
  149. c     ******************** mlreel   ********************
  150. 1800     continue
  151. C Type d'objet non supporte, sortie en erreur
  152.          goto 2
  153. c     ******************** mlenti   ********************
  154. 1900     continue
  155. C Type d'objet non supporte, sortie en erreur
  156.          goto 2
  157. c     ******************** mcharg   ********************
  158. 2000     continue
  159. C Type d'objet non supporte, sortie en erreur
  160.          goto 2
  161. c     ********************          ********************
  162. 2100     continue
  163. C Type d'objet non supporte, sortie en erreur
  164.          goto 2
  165. c     ******************** mevoll   ********************
  166. 2200     continue
  167. C Type d'objet non supporte, sortie en erreur
  168.          goto 2
  169. c     ******************** superele ********************
  170. 2300     continue
  171. C Type d'objet non supporte, sortie en erreur
  172.          goto 2
  173. c     ******************** logique  ********************
  174. 2400     continue
  175. C         nbInt=1
  176. C         nbInTo=nbInTo+1
  177.          goto 1
  178. c     ******************** flottant ********************
  179. 2500     continue
  180. C         nbFloa=1
  181. C         nbFlTo=nbFlTo+nbFloa
  182.          goto 1
  183. c     ******************** entier   ********************
  184. 2600     continue
  185. C         nbInt=1
  186. C         nbInTo=nbInTo+nbInt
  187.          goto 1
  188. c     ******************** mot      ********************
  189. 2700     continue
  190. C         call cmemot(iPoint,nbInt,nbFloa,nbChar)
  191. C         nbInTo=nbInTo+nbInt
  192. C         nbFlTo=nbFlTo+nbFloa
  193. C         nbChTo=nbChTo+nbChar
  194.          goto 1
  195. c     ******************** texte    ********************
  196. 2800     continue
  197. C Type d'objet non supporte, sortie en erreur
  198.          goto 2
  199. c     ******************** listmots ********************
  200. 2900     continue
  201. C Type d'objet non supporte, sortie en erreur
  202.          goto 2
  203. c     ******************** vecteur  ********************
  204. 3000     continue
  205. C Type d'objet non supporte, sortie en erreur
  206.          goto 2
  207. c     ******************** vectd    ********************
  208. 3100     continue
  209. C Type d'objet non supporte, sortie en erreur
  210.          goto 2
  211. c     ******************** point    ********************
  212. 3200     continue
  213.          nbInt=1
  214.          nbInTo=nbInTo+nbInt
  215.          nbFloa=(IDIM+1)
  216.          nbFlTo=nbFlTo+nbFloa
  217.          goto 1
  218. c     ******************** config   ********************
  219. 3300     continue
  220. C        On envoi le idim local et du nb de noeud
  221.          nbInTo=nbInTo+2
  222.          nbFloa=(IDIM+1)*nNoeud
  223.          nbFlTo=nbFlTo+nbFloa
  224.          goto 1
  225. c     ******************** mlchpo   ********************
  226. 3400     continue
  227. C Type d'objet non supporte, sortie en erreur
  228.          goto 2
  229. c     ******************** mbasem   ********************
  230. 3500     continue
  231. C Type d'objet non supporte, sortie en erreur
  232.          goto 2
  233. c     ******************** procedur ********************
  234. 3600     continue
  235. C Type d'objet non supporte, sortie en erreur
  236.          goto 2
  237. c     ******************** bloc     ********************
  238. 3700     continue
  239. C Type d'objet non supporte, sortie en erreur
  240.          goto 2
  241. c     ******************** mmodel   ********************
  242. 3800     continue
  243.          call cmemod(iPoint,nbInt,nbFloa,nbChar)
  244.          nbInTo=nbInTo+nbInt
  245.          nbFlTo=nbFlTo+nbFloa
  246.          nbChTo=nbChTo+nbChar
  247.          goto 1
  248. c     ******************** mchaml   ********************
  249. 3900     continue
  250.          call cmechm(iPoint,nbInt,nbFloa,nbChar)
  251.          nbInTo=nbInTo+nbInt
  252.          nbFlTo=nbFlTo+nbFloa
  253.          nbChTo=nbChTo+nbChar
  254.          goto 1
  255. c     ******************** minte    ********************
  256. 4000     continue
  257.          call cmemin(iPoint,nbInt,nbFloa,nbChar)
  258.          nbInTo=nbInTo+nbInt
  259.          nbFlTo=nbFlTo+nbFloa
  260.          nbChTo=nbChTo+nbChar
  261.          goto 1
  262. c     ******************** nuage    ********************
  263. 4100     continue
  264. C Type d'objet non supporte, sortie en erreur
  265.          goto 2
  266. c     ******************** matrak   ********************
  267. 4200     continue
  268. C Type d'objet non supporte, sortie en erreur
  269.          goto 2
  270. c     ******************** matrik   ********************
  271. 4300     continue
  272. C Type d'objet non supporte, sortie en erreur
  273.          goto 2
  274. c     ******************** objet    ********************
  275. 4400     continue
  276. C Type d'objet non supporte, sortie en erreur
  277.          goto 2
  278. c     ******************** methode  ********************
  279. 4500     continue
  280. C Type d'objet non supporte, sortie en erreur
  281.          goto 2
  282. c     ******************** esclave  ********************
  283. 4600     continue
  284. C Type d'objet non supporte, sortie en erreur
  285.          goto 2
  286. c     ******************** fantome  ********************
  287. 4700     continue
  288. C Type d'objet non supporte, sortie en erreur
  289.          goto 2
  290. c     **************************************************
  291. 1     continue
  292.       if(iimpi.ge.7) then
  293.          write(ioimp,*) 'Taille comptee (int/float/char)'
  294.          write(ioimp,*)  nbInt,nbFloa,nbChar
  295.       endif
  296. 3     continue
  297.       taiTot=0
  299.       call mpipme(nbInTo,'INTE',taille)
  300.       taiTot = taiTot + taille
  301.       call mpipme(nbFlTo,'FLOT',taille)
  302.       taiTot = taiTot + taille
  303.       call mpipme(nbChTo,'CHAR',taille)
  304.       taiTot = taiTot + taille
  305.       if(iimpi.ge.7) then
  306.          write(ioimp,*) 'Taille totale (int/float/char)'
  307.          write(ioimp,*)  nbInTo,nbFlTo,nbChTo
  308.          write(ioimp,*)  taiTot
  309.       endif
  310. C      write(ioimp,*) 'Sortie de CMESLI'
  311.       end
  312.  
  313.  
  314.  
  315.  
  316.  

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