Télécharger coll.eso

Retour à la liste

Numérotation des lignes :

  1. C COLL SOURCE PV 17/12/05 21:15:27 9646
  2. subroutine COLL
  3. integer motCle
  4. integer mesure
  5. integer apIdC
  6. integer corres
  7. integer iexte
  8. integer alead,blead
  9. integer interco,itag
  10. character*10 nomExt
  11. INTEGER OOOVAL
  12. real*8 starttime, endtime;
  13. * real*4 vtime, ttime(2)
  14. * real*4 vtim0, ttim0(2)
  15. real*8 temecou
  16. character*9 mot(10)
  17. character*9 motmes(2)
  18. character*9 motver(1)
  19. data motmes/'MESU','MESO'/
  20. data mot/'DEBUT','FIN','RANG','NOMBRE','ENVOYER','RECEVOIR',
  21. & 'STOP','HORL','PID','POINTEUR'/
  22. -INC SMCOORD
  23. -INC CCOPTIO
  24. -INC CCNOYAU
  25. -INC COCOLL
  26. -INC CCASSIS
  27. -INC TMCOLAC
  28. segment TABICO
  29. integer leau(nTab)
  30. endsegment
  31. pointeur itab.TABICO
  32. pointeur piles.LISPIL
  33.  
  34. call lirmot(motmes,2,mesure,0)
  35.  
  36. segdes mcoord
  37.  
  38. call lirmot(mot,10,motcle,1)
  39. if(motcle.eq.0) then
  40. call erreur (498)
  41. return
  42. endif
  43. if(motcle.lt.9.and.(motcle.ge.2.and.piComm.le.0)) then
  44. write(ioimp,*) 'Impossible d''utiliser MPI sans l''initialiser'
  45. write(ioimp,*) 'Appelez COLL DEBUT avant tout autre appel a
  46. &COLL'
  47. call erreur(223)
  48. return
  49. endif
  50. if(ierr.eq.0) then
  51. if(mesure.ge.1) then
  52. call mpihor(starttime)
  53. endif
  54. if( motcle.eq.1) then
  55. C Initialisation des communications
  56. call lirmot(motext,3,iexte,0)
  57. if(iexte.le.0) then
  58. C Initialisation globale
  59. CALL CDEB
  60. C On sauvegarde le comm de castem comme un autre intercommunicateur
  61. else
  62. if(piComm.le.0) then
  63. write(ioimp,*) 'Impossible d''utiliser MPI sans
  64. &l''initialiser'
  65. write(ioimp,*) 'Appelez COLL DEBUT avant tout autre
  66. &appel a COLL'
  67. call erreur(223)
  68. return
  69. endif
  70. C initialisation des intercommunicteurs
  71. itab = colltopo
  72. segact itab
  73. apIdC = idcext(1)
  74. nomExt = motext(iexte)
  75. iexte = idcext(iexte)
  76. alead = -3
  77. blead = -3
  78. itag = (apIdC * iexte + 1 ) * (apIdC + iexte)
  79.  
  80. C Recherche des leaders (Bring me your leader)
  81. do itop=1,itab.leau(/1)
  82. if ((itab.leau(itop).eq.apIdC).and.(alead.lt.0)) then
  83. alead = itop - 1
  84. endif
  85. if ((itab.leau(itop).eq.iexte).and.(blead.lt.0)) then
  86. blead = itop - 1
  87. endif
  88. enddo
  89. if(blead.eq.-3) then
  90. write(ioimp,12) nomExt
  91. 12 format('Impossible de trouver d''instance de ',A10)
  92. return
  93. endif
  94. call mpiicc(alead,blead,itag,iexteco)
  95. itab = cointeco
  96. segact itab*mod
  97. ntab = itab.leau(/1)
  98. if(ntab.lt.iexte) then
  99. ntab = iexte
  100. segadj itab
  101. endif
  102. itab.leau(iexte) = iexteco
  103. segdes itab
  104. endif
  105.  
  106. else if( motcle.eq.2) then
  107. C Fermeture des communications
  108. C On bloque les assistants pour être sur que les comm sont finis
  109. if (nbesc.ne.0) then
  110. mestra=imestr
  111. segact mestra*mod
  112. call setass(1)
  113. NOMLUS=NOMLU
  114. NOMLU=1
  115. CALL CFIN
  116. segdes mestra
  117. NOMLU=NOMLUS
  118. call setass(0)
  119. else
  120. CALL CFIN
  121. endif
  122. itab = cointeco
  123. segact itab*mod
  124. call libseg(itab)
  125. segdes itab
  126. segsup itab
  127. else if( motcle.eq.3) then
  128. C Recuperation du rang du colloborateur
  129. CALL RGCO
  130. else if( motcle.eq.4) then
  131. C Recuperation du nombre total de collaborateurs
  132. CALL NBCO
  133. else if( motcle.eq.5) then
  134. C Envoi d'un message
  135. call lirmot(motext,3,iexte,0)
  136. call lirent(corres,1,iretou)
  137. if(iexte.le.0) then
  138. call lirmot(motext,3,iexte,0)
  139. endif
  140. if(iexte.le.0) then
  141. iexte = 1
  142. endif
  143. if (ierr.ne.0) then
  144. write(ioimp,*) 'Probleme lors de la lecture du
  145. &destinataire'
  146. return
  147. endif
  148. 121 format('L''intercommunicateur avec ',A10,
  149. &' n''a pas ete initialisse')
  150. itab = cointeco
  151. segact itab
  152. nomExt = motext(iexte)
  153. iexte= idcext(iexte)
  154. if(iexte.le.itab.leau(/1)) then
  155. iexte = itab.leau(iexte)
  156. if(iexte.le.0) then
  157. write(ioimp,121) nomExt
  158. call erreur(223)
  159. return
  160. endif
  161. else
  162. write(ioimp,121) nomExt
  163. call erreur(223)
  164. return
  165. endif
  166. segdes itab
  167. CALL CENV(corres,iexte)
  168. else if( motcle.eq.6) then
  169. C Reception d'un message
  170. C segact mcoord*mod
  171. call lirmot(motext,3,iexte,0)
  172. call lirent(corres,1,iretou)
  173. if(iexte.le.0) then
  174. call lirmot(motext,3,iexte,0)
  175. endif
  176. if(iexte.le.0) then
  177. iexte = 1
  178. endif
  179. if (ierr.ne.0) then
  180. write(ioimp,*) 'Probleme lors de la lecture du
  181. &destinataire'
  182. return
  183. endif
  184. itab = cointeco
  185. segact itab
  186. nomExt = motext(iexte)
  187. iexte= idcext(iexte)
  188. if(iexte.le.itab.leau(/1)) then
  189. iexte = itab.leau(iexte)
  190. if(iexte.le.0) then
  191. write(ioimp,121) nomExt
  192. call erreur(223)
  193. return
  194. endif
  195. else
  196. write(ioimp,121) nomExt
  197. call erreur(223)
  198. return
  199. endif
  200. segdes itab
  201. CALL CREC(corres,iexte)
  202. else if( motcle.eq.7) then
  203. if (nbesc.ne.0) then
  204. mestra=imestr
  205. segact mestra*mod
  206. write(ioimp,*) 'STOP'
  207. segdes mestra
  208. endif
  209. else if( motcle.eq.9) then
  210. ipid = getpid();
  211. call ecrent(ipid)
  212. else if( motcle.eq.8) then
  213. call mpihor(temecou)
  214. call ecrree(temecou)
  215. else if( motcle.eq.10) then
  216. CALL cpoint
  217. endif
  218. if(mesure.ge.1) then
  219. call mpihor(endtime)
  220. * print *, 'elapsed:', vtime-vtim0, ', user:', ttime(1)-ttim0(1),
  221. * & ', sys:', ttime(2)-ttim0(2)
  222. endif
  223. endif
  224. if(mesure.ge.2) then
  225. temecou = endtime - starttime
  226. call ecrree(temecou)
  227. endif
  228. end
  229.  
  230.  
  231.  
  232.  
  233.  
  234.  

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