Télécharger crec.eso

Retour à la liste

Numérotation des lignes :

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

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