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

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