Télécharger cmelis.eso

Retour à la liste

Numérotation des lignes :

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

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