Télécharger cenv.eso

Retour à la liste

Numérotation des lignes :

cenv
  1. C CENV SOURCE PV 20/03/30 21:15:45 10567
  2. subroutine CENV(colDes,iComm)
  3. C L'operateur CENV (COLlaborateur ENVoyer) permet d'envoyer une liste d'objet en
  4. C argument au collaborateur colDes, donne également en argument
  5. CEn se basant sur le fonctionnement du sauver, le fonctionnement est le
  6. C suivant :
  7. C -Recuperer la liste des arguments
  8. C -Verifier que le type des objets est correct
  9. C -Faire un premier remplissage des piles avec la liste d'argument
  10. C -Chercher les objets nécessaires pour la liste d'argument
  11. C -Envoyer cette liste
  12. C -Recevoir la liste des objets a envoyer
  13. C -Chercher la taille du buffer et l'allouer
  14. C -Remplir le buffer
  15. C -Envoyer le buffer
  16. C -FIN
  17. C Declaration des variables
  18. character*(8) typNom
  19. integer typNum
  20. integer nArg
  21. integer iComm
  22. integer iretou,i,ipile
  23. integer iPoint,nNoeud
  24. integer colDes,colMoi
  25. integer lonBuf
  26. integer taille
  27. integer bufPos
  28. integer nitlac
  29. integer totCol
  30. integer tagPre,tagMan,tagObj
  31. C Variable pour la lecture des entiers
  32. real*8 xval
  33. integer ival
  34. character*512 cval
  35. logical logval
  36. integer iob
  37. integer nbRee,nbCha,nbMot
  38.  
  39.  
  40. -INC PPARAM
  41. -INC CCOPTIO
  42. -INC COCOLL
  43. -INC SMCOORD
  44. -INC TMCOLAC
  45. -INC CCASSIS
  46. -INC CCNOYAU
  47. C Declaration des types de segment
  48. segment BUFFER
  49. character ffer(lonBuf)
  50. endsegment
  51. segment PILOC
  52. real*8 reel(nbRee)
  53. character*(nbCha) chara
  54. integer motdeb(nbMot+1)
  55. endsegment
  56. segment LISARG
  57. character*8 nom(nArg)
  58. integer adress(nArg)
  59. endsegment
  60. pointeur argume.LISARG
  61. pointeur lisMan.LISARG
  62. pointeur lisReq.LISARG
  63. c Pointeur des gestions des assistants
  64. c pointeur mestra.MESTRA
  65. pointeur piles.LISPIL
  66. pointeur jcolac.ICOLAC
  67. pointeur lcolac.ICOLAC
  68. pointeur pilReq.ICOLAC
  69. pointeur jtlacc.ITLACC
  70. pointeur jlisse.ILISSE
  71. pointeur bu.BUFFER
  72. pointeur pilLoc.PILOC
  73. if(iimpi.ge.7) then
  74. write(ioimp,*) 'Entre dans CENV'
  75. write(ioimp,*) icomm
  76. endif
  77. nbRee=0
  78. nbCha=0
  79. nbMot=0
  80. lonBuf=0
  81. colMoi=0
  82. tagPre=12
  83. tagMan=14
  84. tagObj=15
  85. totCol=0
  86. piles = piComm
  87. C write(ioimp,*) 'piComm dans cenv',piles
  88. segact piles
  89. C Il faut garder le segments piles actifs, cela permet de bloquer
  90. C en ecriture le segment et donc de bloquer les appels a cfin
  91. C avant que les envois et receptions ne soient termines
  92. C Ce blocage n'empeche pas des envois / receptions simultanee car
  93. C on active en lecture, seul cdeb et cfin activent en mod
  94. segini pilLoc
  95. pilLoc.motDeb(1)=1
  96. call mpinbc ( totCol)
  97. if(icomm.eq.mpiComCa) then
  98. if(colDes.gt.totCol.or.colDes.lt.1) then
  99. write(ioimp,*)'Le numero du destinataire n''est pas correct'
  100. write(ioimp,*) colDes
  101. moterr( 1: 8) = 'collabor'
  102. call erreur(645)
  103. return
  104. else
  105. if(iimpi.ge.6) then
  106. write(ioimp,*) 'Debut de l''envoi au collaborateur ',
  107. & (colDes)
  108. endif
  109. endif
  110. else
  111. if(iimpi.ge.6) then
  112. write(ioimp,*) 'Debut de l''envoi vers l''exterieur ',
  113. & icomm, colDes
  114. endif
  115. endif
  116. call mpirgc ( colMoi )
  117.  
  118. nArg=0
  119. segini argume
  120. C INTEXT est une variable globale (cf CCNOYAU)
  121. typNom=' '
  122. C lecture d'un possible premier argume
  123. call quetyp(typNom,0,iretou)
  124. do while(iretou.eq.1)
  125. c------- on controle la validite du type demande
  126. typNum=0
  127. call typfil (typNom,typNum)
  128. if (typNum.eq.1 ) then
  129. call lirobj(typNom,iPoint,1,iretou)
  130. elseif (typNum.eq.2 ) then
  131. call lirobj(typNom,iPoint,1,iretou)
  132. elseif (typNum.eq.3 ) then
  133. call lirobj(typNom,iPoint,1,iretou)
  134. elseif (typNum.eq.24) then
  135. call lirlog(logval,1,iretou)
  136. if(logval) then
  137. iPoint=1
  138. else
  139. iPoint=0
  140. endif
  141. elseif (typNum.eq.25) then
  142. call lirree(xval,1,iretou)
  143. nbRee=nbRee+1
  144. segadj pilLoc
  145. iPoint=nbRee
  146. pilLoc.reel(iPoint)=xval
  147. elseif (typNum.eq.26) then
  148. call lirent(ival,1,iretou)
  149. iPoint=ival
  150. elseif (typNum.eq.27) then
  151. call lircha(cval,1,ival)
  152. nbMot=nbMot+1
  153. nbCha=nbCha+ival
  154. segadj pilLoc
  155. iPoint=nbMot
  156. pilLoc.motDeb(nbMot+1)=nbCha+1
  157. pilLoc.chara(nbCha-ival+1:nbCha)=cval(1:ival)
  158. elseif (typNum.eq.32) then
  159. call lirobj(typNom,iPoint,1,iretou)
  160. elseif (typNum.eq.33) then
  161. call lirobj(typNom,iPoint,1,iretou)
  162. elseif (typNum.eq.38) then
  163. call lirobj(typNom,iPoint,1,iretou)
  164. elseif (typNum.eq.39) then
  165. call lirobj(typNom,iPoint,1,iretou)
  166. else
  167. moterr(1:8)=typNom
  168. call erreur(39)
  169. return
  170. endif
  171.  
  172. c------- le type est ok, on l'ajoute a la liste
  173. nArg=nArg+1
  174. segadj argume
  175. argume.nom(nArg)=typNom
  176. argume.adress(nArg)=iPoint
  177. if(iimpi.ge.7) then
  178. write(ioimp,*) 'Ajout d un argument de type ',typNom
  179. write(ioimp,*) 'et de pointeur ',iPoint
  180. endif
  181. C On test s'il y a encore qq ch dans la pile pour savoir si on
  182. C refait une iteration ou pas
  183. typNom=' '
  184. call quetyp(typNom,0,iretou)
  185. enddo
  186. iretou = 0
  187.  
  188. if (nArg.eq.0) then
  189. segdes argume
  190. segsup argume
  191. moterr(1:8)=' '
  192. call erreur(37)
  193. else
  194. C write(ioimp,*) 'Nombre d'objets a sauver', nArg
  195. endif
  196. C Si on est le propre destinataire, inutile d'enoyer les objets
  197. if(colMoi+1.ne.colDes.or.icomm.ne.mpicomCa) then
  198. C Premier remplissage des piles avec la liste d'arguments lus
  199. typNom=' '
  200. typNum=-1
  201. call typfil(typNom,typNum)
  202. nitlac=-typNum
  203. call crepil(pilReq,nitlac)
  204. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  205. CC * attention aux assistants ....
  206. *te if (nbesc.ne.0) then
  207. C if (iimpi .eq. 1234)
  208. c write(ioimp,*) 'il faut bloquer les assistants'
  209. C mestra=imestr
  210. C segact mestra*mod
  211. *te call threadii
  212. C call ooofrc(1)
  213. C call setass(1)
  214. *te endif
  215. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  216. call filllu(argume,pilReq)
  217. C Second remplissage avec les objets references
  218. segact argume*mod
  219. segact mcoord
  220. call fillpi(pilReq)
  221. segdes mcoord
  222. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  223. *te if (nbesc.ne.0) then
  224. C call setass(0)
  225. C call ooofrc(0)
  226. C segact mestra
  227. *te call threadis
  228. *te endif
  229. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  230. segact pilReq*mod
  231. C write(ioimp,*) 'activation du segment de comm', colDes, jcolac
  232. lcolac = piles.proc(colDes)
  233. segini,jcolac=lcolac
  234. C segact jcolac*mod
  235. jlisse = jcolac.ilissg
  236. segact jlisse*mod
  237. do ipile=1,jcolac.kcola(/1)
  238. jtlacc=jcolac.kcola(ipile)
  239. if(jtlacc.gt.0) segact jtlacc*mod
  240. enddo
  241. call cinipi(jcolac)
  242. C Ajout des piles pilReq dans jcolac et renumerotation de pilReq
  243. call cajppi(pilReq,jcolac,.true.)
  244. C write(ioimp,*) 'desactivation du segment de comm', colDes, jcolac
  245. do ipile=1,jcolac.kcola(/1)
  246. jtlacc=jcolac.kcola(ipile)
  247. if(jtlacc.gt.0) segdes jtlacc
  248. enddo
  249. segdes jlisse
  250.  
  251. C Conversion des piles pilReq et list lisReq
  252. nArg=0
  253. segini lisReq
  254. C call savseg(lisReq)
  255. call cpi2li(pilReq,lisReq)
  256. call clibpi(pilReq)
  257. if(iimpi.ge.7) then
  258. write(ioimp,*) 'Objets dans la liste des prerequis:'
  259. do i=1,lisReq.adress(/1)
  260. write(ioimp,*) i,lisReq.adress(i),lisReq.nom(i)
  261. enddo
  262. endif
  263. C Mesure de la liste lisReq
  264. lonBuf=0
  265. call cmearg(lisReq,taille)
  266. lonBuf = lonBuf + taille
  267. C Allocation du buffer
  268. segini bu
  269. bufPos=0
  270. C Paquettage de la liste des objets necessaires
  271. call cpaarg(lisReq,bu,bufPos)
  272. segsup lisReq
  273. C Envoi de la liste des objets necessaires
  274. if(iimpi.ge.6) then
  275. write(ioimp,*) 'Envoi de la liste des prerequis au coll',
  276. & colDes
  277. write(ioimp,*) 'Longueur du buffer :', bufPos
  278. endif
  279. call mpiEnv(colDes,iComm,tagPre,bu,bufPos)
  280. c Reception de la liste des objets a envoyer
  281. if(iimpi.ge.6) then
  282. write(ioimp,*) 'Attente de la liste des objets a envoyer'
  283. endif
  284. call mpiRcv(colDes,iComm,tagMan,bu)
  285. bufPos = 0
  286. nArg=0
  287. C Extraction de la liste des objets a envoyer du buffer
  288. call cuparg(bu,bufPos,lisMan)
  289. segsup bu
  290. C Conversion dans lisMan des positions dans la pile en pointeur
  291. segact jlisse
  292. do ipile=1,jcolac.kcola(/1)
  293. jtlacc=jcolac.kcola(ipile)
  294. if(ipile.lt.24.or.ipile.gt.27) then
  295. if(jtlacc.gt.0) segact jtlacc
  296. else
  297. if(jtlacc.gt.0) segact jtlacc*mod
  298. endif
  299. enddo
  300. if(iimpi.ge.6) then
  301. write(ioimp,*) 'Liste des objets manquants recus'
  302. endif
  303. call clip2s(jcolac,lisMan)
  304. C Calcul de la taille du message et allocation
  305. lonBuf=0
  306. call cmelis(lisMan,jcolac,taille)
  307. lonBuf = lonBuf + taille
  308. call cmeplo(pilLoc,taille)
  309. lonBuf = lonBuf + taille
  310. lonBuf = lonBuf + taille
  311. C write(ioimp,*) 'allocation d un buffer de taille',lonBuf
  312. segini bu
  313. bufPos=0
  314. C Paquettage des objets
  315. if(iimpi.ge.6) then
  316. write(ioimp,*) 'Paquettage des objets'
  317. endif
  318. call cpaplo(pilLoc,bu,bufPos)
  319. segsup pilLoc
  320. segact mcoord
  321. nNoeud=nbpts
  322. call cpalis(lisMan,jcolac,nNoeud,bu,bufPos)
  323. segdes mcoord
  324.  
  325. segsup lisMan
  326. C Renumerotation de la liste des arguments
  327. call clis2p(jcolac,argume)
  328. do ipile=1,jcolac.kcola(/1)
  329. jtlacc=jcolac.kcola(ipile)
  330. if(ipile.lt.24.or.ipile.gt.27) then
  331. segdes jtlacc
  332. else
  333. C call libseg(jtlacc)
  334. segsup jtlacc
  335. jcolac.kcola(ipile)=0
  336. endif
  337. enddo
  338. segdes jlisse
  339. segsup jcolac
  340.  
  341. C Paquettage des la liste des objets a retourner
  342. if(iimpi.ge.6) then
  343. write(ioimp,*) 'Paquettage de la liste des arguments'
  344. endif
  345. call cpaarg(argume,bu,bufPos)
  346. segdes argume
  347. C call libseg(argume)
  348. segsup argume
  349. C Envoi du message
  350. if(iimpi.ge.6) then
  351. write(ioimp,*) 'Envoi des objets au coll',colDes
  352. endif
  353. C if (nbesc.ne.0) then
  354. C segdes mestra
  355. C endif
  356. call mpiEnv(colDes,iComm,tagObj,bu,bufPos)
  357. if(iimpi.ge.6) then
  358. write(ioimp,*) 'Fin de l''envoi a ',colDes
  359. endif
  360. else
  361. C Cas d'un message envoyer a soi meme
  362. lonBuf = taille
  363. call cmeplo(pilLoc,taille)
  364. lonBuf = lonBuf+taille
  365. C write(ioimp,*) 'allocation d un buffer de taille',lonBuf
  366. segini bu
  367. bufPos=0
  368. call cpaplo(pilLoc,bu,bufPos)
  369. segsup pilLoc
  370. call cpaarg(argume,bu,bufPos)
  371. segdes argume
  372. segsup argume
  373. C Envoi du message
  374. if(iimpi.ge.6) then
  375. write(ioimp,*) 'Envoi du message a soi meme '
  376. endif
  377. call mpiEnv(colDes,iComm,tagObj,bu,bufPos)
  378. endif
  379. segdes piles
  380.  
  381. C L'envoi est termine, on peut debloquer le segment piles (cf
  382. C remarque lors de l'activation de ce segment)
  383. C write(ioimp,*) 'Sortie de CENV'
  384. end
  385.  
  386.  
  387.  
  388.  
  389.  
  390.  
  391.  

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