Télécharger crec.eso

Retour à la liste

Numérotation des lignes :

  1. C CREC SOURCE PV 17/12/05 21:15:41 9646
  2. subroutine crec(colExp,iComm)
  3. C L'operateur CREC (COLlaborateur RECevoir) permet de recevoir la liste d'objet
  4. C envoye par le collaborateur colExp, qui doit etre fournit en
  5. C argument.
  6. C En basant sur le fonctionnement du rest, le fonctionnement est le
  7. C suivant :
  8. C -Recuperer la liste des objets necessaire
  9. C -Chercher les objets manquants et envoyer la liste
  10. C -Recevoir les objets manquants
  11. C -Faire correspondre les objets references avec leur pointeur esope
  12. C -Retourner a l'utilisateur la liste des objets attendus
  13. C -Faire le menage et quitter
  14. integer nArg
  15. integer iComm
  16. integer iretou
  17. integer ipile
  18. integer colExp,colMoi
  19. integer totCol
  20. integer lonBuf
  21. integer taille
  22. integer bufPos
  23. integer nivErr
  24. integer tagPre,tagMan,tagObj
  25. integer nbRee,nbCha,nbMot
  26. integer nproc,iproc
  27. integer nitlac
  28. character*(8) typNom
  29. integer typNum
  30. C-INC SMELEME
  31. -INC SMCOORD
  32. -INC TMCOLAC
  33. C-INC CCASSIS
  34. -INC COCOLL
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. C Declaration des types de segment
  39. segment BUFFER
  40. character ffer(lonBuf)
  41. endsegment
  42.  
  43. segment LISARG
  44. character*8 nom(nArg)
  45. integer adress(nArg)
  46. endsegment
  47. segment PILOC
  48. real*8 reel(nbRee)
  49. character*(nbCha) chara
  50. integer motdeb(nbMot+1)
  51. endsegment
  52. pointeur pilLoc.PILOC
  53. C Declaration des variables
  54. pointeur argume.LISARG
  55. pointeur lisMan.LISARG
  56. pointeur lisReq.LISARG
  57. c Pointeur des gestions des assistants
  58. c pointeur mestra.MESTRA
  59. pointeur piles.LISPIL
  60. pointeur jcolac.ICOLAC
  61. pointeur lcolac.ICOLAC
  62. pointeur jtlacc.ITLACC
  63. pointeur jlisse.ILISSE
  64. pointeur bu.BUFFER
  65.  
  66.  
  67.  
  68. C write(ioimp,*) 'Entre dans CREC'
  69. nivErr=0
  70. C write(ioimp,*) 'piComm dans crec',piles
  71. colMoi=0
  72. tagPre=12
  73. tagMan=14
  74. tagObj=15
  75. iretou = 0
  76. totCol=0
  77. piles = piComm
  78. segact piles
  79. C Il faut garder le segments piles actifs, cela permet de bloquer
  80. C en ecriture le segment et donc de bloquer les appels a cfin
  81. C avant que les envois et receptions ne soient termines
  82. C Ce blocage n'empeche pas des envois / receptions simultanee car
  83. C on active en lecture, seul cdeb et cfin activent en mod
  84. call mpinbc(totCol)
  85. if(icomm.eq.mpiComCa) then
  86. if(colExp.gt.totCol.or.colExp.lt.1) then
  87. write(ioimp,*)'Le numero de l''expediteur n''est pas correct'
  88. write(ioimp,*)colExp
  89. moterr( 1: 8) = 'collabor'
  90. call erreur(645)
  91. return
  92. else
  93. if(iimpi.ge.6) then
  94. write(ioimp,*) 'Debut de la reception depuis ',
  95. & ' collaborateur'
  96. & ,colExp
  97. endif
  98. endif
  99. else
  100. if(iimpi.ge.6) then
  101. write(ioimp,*) 'Debut de la reception depuis l''exterieur ',
  102. & icomm, colExp
  103. endif
  104. endif
  105. call mpirgc(colMoi)
  106. C Activation de la pile concernee
  107. if(colMoi+1.ne.colExp.or.icomm.ne.mpicomCa) then
  108. C probe du message
  109. C write(ioimp,*) 'Sonde du message'
  110. if(iimpi.ge.6) then
  111. write(ioimp,*) 'En Attente de la liste des objet requis...'
  112. endif
  113. call mpiRcv(colExp, iComm, tagPre, bu)
  114. bufPos = 0
  115. C Initialisation et lecture de la liste des requis
  116. call cuparg(bu,bufPos,lisReq)
  117. segsup bu
  118. lcolac = piles.proc(colExp)
  119. C write(ioimp,*) 'activation du segment de comm', colExp, jcolac
  120. segini,jcolac=lcolac
  121. jlisse = jcolac.ilissg
  122. segact jlisse*mod
  123. do ipile=1,jcolac.kcola(/1)
  124. jtlacc=jcolac.kcola(ipile)
  125. if(ipile.lt.24.or.ipile.gt.27) then
  126. if(jtlacc.gt.0) segact jtlacc
  127. else
  128. if(jtlacc.gt.0) segact jtlacc*mod
  129. endif
  130. enddo
  131. call cinipi(jcolac)
  132. C Recherche des objets manquants
  133. nArg=0
  134. segini lisMan
  135. call cdpili(lisReq,jcolac,lisMan)
  136. C write(ioimp,*) 'activation du segment de comm', colDes, jcolac
  137. do ipile=1,jcolac.kcola(/1)
  138. jtlacc=jcolac.kcola(ipile)
  139. if(jtlacc.gt.0) segdes jtlacc
  140. enddo
  141. segdes jlisse
  142.  
  143. lonBuf=0
  144. call cmearg(lisMan,taille)
  145. lonBuf = lonBuf + taille
  146. segini bu
  147. bufPos=0
  148. C Paquettage de la liste des objets necessaires
  149. call cpaarg(lisMan,bu,bufPos)
  150. if(iimpi.ge.6) then
  151. write(ioimp,*) 'Envoi de la liste des manquants au col',
  152. & icomm, colExp
  153. endif
  154. call mpiEnv(colExp,iComm,tagMan,bu,bufPos)
  155. if(iimpi.ge.6) then
  156. write(ioimp,*) 'Liste des objets manquants envoyes'
  157. write(ioimp,*) 'En Attente des objets'
  158. endif
  159. C probe du message
  160. if(iimpi.ge.6) then
  161. write(ioimp,*) 'En attente des objets'
  162. endif
  163. call mpiRcv(colExp,iComm, tagObj, bu)
  164. bufPos = 0
  165. C Initialisation et lecture de la liste des arguments
  166. C Lecture de l'increment de pile recu
  167. C write(ioimp,*) 'activation du segment de comm', colDes, jcolac
  168. segact jlisse*mod
  169. do ipile=1,jcolac.kcola(/1)
  170. jtlacc=jcolac.kcola(ipile)
  171. if(jtlacc.gt.0) segact jtlacc*mod
  172. enddo
  173. nbRee=0
  174. nbCha=0
  175. nbMot=0
  176. segini pilLoc
  177. call cupplo(bu,bufPos,pilLoc)
  178. call cuplis(lisMan,bu,bufPos,jcolac,nivErr)
  179. if(nivErr.ne.0) return
  180. call cuparg(bu,bufPos,argume)
  181. segsup bu
  182. C Lie les objets references a leur pointeur esope
  183. if(iimpi.ge.6) then
  184. write(ioimp,*) 'Fin de la reception depuis le coll',colExp
  185. endif
  186. call clilis(lisMan,jcolac)
  187. segsup lisMan
  188. C Envoi des objets en sortie d'operateur
  189.  
  190. call clip2s(jcolac,argume)
  191. call cretar(argume,pilLoc)
  192. segsup pilLoc
  193. C write(ioimp,*) 'Desactivation du segment de comm', colExp, jcolac
  194. C Desactivation de tout les segments contenus dans jcolac
  195. do ipile=1,jcolac.kcola(/1)
  196. jtlacc=jcolac.kcola(ipile)
  197. if(ipile.lt.24.or.ipile.gt.27) then
  198. segdes jtlacc
  199. else
  200. segsup jtlacc
  201. jcolac.kcola(ipile)=0
  202. endif
  203. enddo
  204. segdes jlisse
  205. segsup jcolac
  206. else
  207. C Message envoye a soi meme
  208. C probe du message
  209. if(iimpi.ge.6) then
  210. write(ioimp,*) 'En Attente de la liste des arguments de soi'
  211. endif
  212. call mpiRcv(colExp, iComm, tagObj, bu)
  213. bufPos = 0
  214. nbRee=0
  215. nbCha=0
  216. nbMot=0
  217. segini pilLoc
  218. call cupplo(bu,bufPos,pilLoc)
  219. call cuparg(bu,bufPos,argume)
  220. segsup bu
  221. call cretar(argume,pilLoc)
  222. segsup pilLoc
  223. endif
  224. segdes piles
  225. C La reception est terminee, on peut debloquer le segment piles
  226. C (cf remarque lors de l'activation de ce segment)
  227. segsup argume
  228. C write(ioimp,*) 'Sortie de CREC',colExp
  229. end
  230.  
  231.  
  232.  
  233.  
  234.  
  235.  
  236.  

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