Télécharger cmelis.eso

Retour à la liste

Numérotation des lignes :

  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
  298. call mpipme(nbInTo,'INTE',taille)
  299. taiTot = taiTot + taille
  300. call mpipme(nbFlTo,'FLOT',taille)
  301. taiTot = taiTot + taille
  302. call mpipme(nbChTo,'CHAR',taille)
  303. taiTot = taiTot + taille
  304. if(iimpi.ge.7) then
  305. write(ioimp,*) 'Taille totale (int/float/char)'
  306. write(ioimp,*) nbInTo,nbFlTo,nbChTo
  307. write(ioimp,*) taiTot
  308. endif
  309. C write(ioimp,*) 'Sortie de CMESLI'
  310. end
  311.  
  312.  
  313.  
  314.  
  315.  

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