Télécharger coll.eso

Retour à la liste

Numérotation des lignes :

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

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