Télécharger appmpi.eso

Retour à la liste

Numérotation des lignes :

  1. C APPMPI SOURCE GF238795 16/10/18 21:15:01 9131
  2. %IF UNIX64
  3. subroutine mpienv(colDes,colcom,tag,bu,bufPos)
  4.  
  5. C=======================================================================
  6. c routine mpiEnv
  7. c Wrapper pour l'envoi de message avec MPI
  8. c Avantage : Lieu unique pour la gestion des erreurs
  9. c Passage a autre chose que MPI plus aise
  10. c Localisation de l'include mpi.h
  11. c
  12. C=======================================================================
  13. include 'mpif.h'
  14. -INC COCOLL
  15. integer inbuf(2)
  16. integer incount
  17. integer bufPos
  18. integer lonBuf
  19. integer colDes
  20. integer colcom
  21. integer tag
  22. integer mpiErr
  23. segment BUFFER
  24. character*1 ffer(lonBuf)
  25. endsegment
  26. pointeur bu.BUFFER
  27. lonBuf=bu.ffer(/2)
  28. mpiErr=0
  29. call ooosbl
  30. call MPI_Send(bu.ffer, bufPos,mpiTyPac , colDes-1,
  31. & tag,colcom , mpiErr)
  32. call oooubl
  33. segsup bu
  34. if(mpiErr.ne.0) call erreur(5)
  35. return
  36. end
  37.  
  38. subroutine mpifin()
  39.  
  40. C=======================================================================
  41. c routine mpifin
  42. c Wrapper pour l'appel a MPI_Finalize
  43. c Avantage : Lieu unique pour la gestion des erreurs
  44. c Passage a autre chose que MPI plus aise
  45. c Localisation de l'include mpi.h
  46. c
  47. C=======================================================================
  48. include 'mpif.h'
  49. -INC COCOLL
  50. integer mpiErr
  51. segment TABTOP
  52. integer leau(nTab)
  53. endsegment
  54. pointeur itab.TABTOP
  55. mpiErr=0
  56. call MPI_Finalize ( mpiErr )
  57. if(mpiErr.ne.0) call erreur(5)
  58. itab=colltopo
  59. segact itab*mod
  60. call libseg(itab)
  61. segdes itab
  62. segsup itab
  63. colltopo = 0
  64. return
  65. end
  66.  
  67.  
  68. subroutine mpihor(valtime)
  69.  
  70. C=======================================================================
  71. c routine mpihor
  72. c Wrapper pour l'appel a MPI_Wtime
  73. c Avantage : Lieu unique pour la gestion des erreurs
  74. c Passage a autre chose que MPI plus aise
  75. c Localisation de l'include mpi.h
  76. c
  77. C=======================================================================
  78. include 'mpif.h'
  79. -INC COCOLL
  80. real*8 valtime
  81. valtime = MPI_Wtime()
  82. return
  83. end
  84.  
  85.  
  86. subroutine mpiini()
  87.  
  88. C=======================================================================
  89. c routine mpinbc
  90. c Wrapper pour l'appel a mpi_init_thread
  91. c Avantage : Lieu unique pour la gestion des erreurs
  92. c Passage a autre chose que MPI plus aise
  93. c Localisation de l'include mpi.h
  94. c
  95. C=======================================================================
  96. include 'mpif.h'
  97. -INC CCOPTIO
  98. -INC COCOLL
  99. integer mpiErr
  100. integer nivmpi
  101. integer NPROC
  102. integer IPRANK
  103. integer ntab
  104. integer taille
  105. C Numero d'identification de Castem
  106. integer appIDCa
  107. segment TABTOP
  108. integer leau(nTab)
  109. endsegment
  110. pointeur itab.TABTOP
  111.  
  112. appIdCa = idcext(1)
  113. mpiErr=0
  114. nivmpi =0
  115.  
  116.  
  117. call mpi_init_thread(MPI_THREAD_MULTIPLE, nivmpi, mpiErr )
  118. if(mpiErr.ne.0) call erreur(5)
  119. mpicomWo = MPI_COMM_WORLD
  120. NPROC = 0
  121. IPRANK = 0
  122. CALL MPI_COMM_SIZE(MPI_COMM_WORLD, NPROC, IERR)
  123. CALL MPI_COMM_RANK(MPI_COMM_WORLD, IPRANK, IERR)
  124. C Allocation du tableau de topologie
  125. nTab = NPROC
  126. segini itab
  127.  
  128.  
  129. call MPI_Allgather( appIDCa , 1, MPI_INTEGER8,
  130. & itab.leau, 1, MPI_INTEGER8, MPI_COMM_WORLD, ierr)
  131. colltopo=itab
  132. call savseg(itab)
  133. segdes itab
  134. if(iimpi.ge.6) then
  135. write(6,*) '** kk2000 : place dans le monde',IPRANK, '/ ',
  136. & NPROC
  137. endif
  138. call MPI_COMM_SPLIT(mpicomWo, appIdCa, 0, mpicomca, mpiErr)
  139. if(iimpi.ge.6) then
  140. write(ioimp,*) 'Creation du communicateur propre Castem'
  141. write(ioimp,*) 'Numero de comm',mpicomca
  142. endif
  143. if(mpiErr.ne.0) call erreur(5)
  144. mpiTyFlo=MPI_REAL8
  145. mpiTyEnt=MPI_INTEGER8
  146. mpiTyCha=MPI_CHARACTER
  147. mpiTyLog=MPI_LOGICAL
  148. mpiTyPac=MPI_PACKED
  149. if(iimpi.ge.6) then
  150. taille = 0
  151. call MPI_TYPE_SIZE(mpiTyFlo,taille , mpiErr)
  152. write(ioimp,*) 'Taille de mpiTyFlo', taille
  153. call MPI_TYPE_SIZE(mpiTyEnt,taille , mpiErr)
  154. write(ioimp,*) 'Taille de mpiTyEnt', taille
  155. call MPI_TYPE_SIZE(mpiTyCha,taille , mpiErr)
  156. write(ioimp,*) 'Taille de mpiTyCha', taille
  157. call MPI_TYPE_SIZE(mpiTyLog,taille , mpiErr)
  158. write(ioimp,*) 'Taille de mpiTyLog', taille
  159. call MPI_TYPE_SIZE(mpiTyPac,taille , mpiErr)
  160. write(ioimp,*) 'Taille de mpiTyPac', taille
  161. endif
  162.  
  163. nTab = idcext(1)
  164. segini itab
  165. call savseg(itab)
  166. cointeco = itab
  167. itab.leau( idcext(1)) = mpicomca
  168. segdes itab
  169.  
  170. return
  171. end
  172.  
  173.  
  174. subroutine mpinbc(nbc)
  175.  
  176. C=======================================================================
  177. c routine mpinbc
  178. c Wrapper pour l'appel a MPI_Comm_size
  179. c Avantage : Lieu unique pour la gestion des erreurs
  180. c Passage a autre chose que MPI plus aise
  181. c Localisation de l'include mpi.h
  182. c
  183. C=======================================================================
  184. include 'mpif.h'
  185. -INC COCOLL
  186. integer nbc
  187. integer mpiErr
  188. mpiErr=0
  189. call MPI_Comm_size ( mpicomCa, nbc, mpiErr )
  190. if(mpiErr.ne.0) call erreur(5)
  191. return
  192. end
  193.  
  194.  
  195. subroutine mpipac(inbuf,incount,bu,bufpos)
  196. C=======================================================================
  197. c routine mpiPaC
  198. c Wrapper pour l'appel a mpi_pack avec un tableau de caracteres en
  199. c arguement.
  200. c Pour OK compilation sous AIX
  201. c Avantage : Lieu unique pour la gestion des erreurs
  202. c Passage a autre chose que MPI plus aise
  203. c Localisation de l'include mpi.h
  204. c
  205. C=======================================================================
  206. include 'mpif.h'
  207. -INC COCOLL
  208. character inbuf(2)
  209. integer incount
  210. integer bufPos
  211. integer lonBuf
  212. integer mpiErr
  213. segment BUFFER
  214. character*1 ffer(lonBuf)
  215. endsegment
  216. pointeur bu.BUFFER
  217. lonBuf=bu.ffer(/2)
  218. mpiErr=0
  219. call MPI_PACK(inbuf,incount,mpiTyCha,bu.ffer,lonBuf,
  220. & bufPos,mpicomCa,mpiErr)
  221. if(mpiErr.ne.0) call erreur(5)
  222. C write(ioimp,*) 'Sortie mpipac.eso'
  223. return
  224. end
  225.  
  226.  
  227. subroutine mpipai(inbuf,incount,bu,bufpos)
  228. C=======================================================================
  229. c routine mpiPaC
  230. c Wrapper pour l'appel a mpi_pack avec un tableau de caracteres en
  231. c arguement.
  232. c Pour OK compilation sous AIX
  233. c Avantage : Lieu unique pour la gestion des erreurs
  234. c Passage a autre chose que MPI plus aise
  235. c Localisation de l'include mpi.h
  236. c
  237. C=======================================================================
  238. include 'mpif.h'
  239. -INC COCOLL
  240. integer inbuf(2)
  241. integer incount
  242. integer bufPos
  243. integer lonBuf
  244. integer mpiErr
  245. segment BUFFER
  246. character*1 ffer(lonBuf)
  247. endsegment
  248. pointeur bu.BUFFER
  249. lonBuf=bu.ffer(/2)
  250. mpiErr=0
  251. call MPI_PACK(inbuf,incount,mpiTyEnt,bu.ffer,lonBuf,
  252. & bufPos,mpicomCa,mpiErr)
  253. if(mpiErr.ne.0) call erreur(5)
  254. c write(ioimp,*) 'Sortie mpipai.eso'
  255. return
  256. end
  257.  
  258.  
  259. subroutine mpipar(inbuf,incount,bu,bufpos)
  260. C=======================================================================
  261. c routine mpiPaC
  262. c Wrapper pour l'appel a mpi_pack avec un tableau de caracteres en
  263. c arguement.
  264. c Pour OK compilation sous AIX
  265. c Avantage : Lieu unique pour la gestion des erreurs
  266. c Passage a autre chose que MPI plus aise
  267. c Localisation de l'include mpi.h
  268. c
  269. C=======================================================================
  270. include 'mpif.h'
  271. -INC COCOLL
  272. real*8 inbuf(2)
  273. integer incount
  274. integer bufPos
  275. integer lonBuf
  276. integer mpiErr
  277. segment BUFFER
  278. character*1 ffer(lonBuf)
  279. endsegment
  280. pointeur bu.BUFFER
  281. lonBuf=bu.ffer(/2)
  282. mpiErr=0
  283. call MPI_PACK(inbuf,incount,mpiTyFlo,bu.ffer,lonBuf,
  284. & bufPos,mpicomCa,mpiErr)
  285. if(mpiErr.ne.0) call erreur(5)
  286. c write(ioimp,*) 'Sortie mpipar.eso'
  287. return
  288. end
  289.  
  290.  
  291. subroutine mpipme(nbel,type,taille)
  292.  
  293. C=======================================================================
  294. c routine mpipme
  295. c Wrapper pour l'appel a mpi_pack_size
  296. c Avantage : Lieu unique pour la gestion des erreurs
  297. c Passage a autre chose que MPI plus aise
  298. c Localisation de l'include mpi.h
  299. c
  300. C=======================================================================
  301. include 'mpif.h'
  302. -INC COCOLL
  303. integer nbel
  304. character*4 type
  305. integer mpity
  306. integer taille
  307. integer mpiErr
  308. mpity=-1
  309. mpiErr=0
  310. if(type .eq. 'INTE') then
  311. mpity = mpiTyFlo
  312. endif
  313. if(type .eq. 'FLOT') then
  314. mpity = mpiTyEnt
  315. endif
  316. if(type .eq. 'CHAR') then
  317. mpity = mpiTyCha
  318. endif
  319. call MPI_PACK_SIZE(nbel, mpity, mpicomCa, taille, mpiErr)
  320. if(mpiErr.ne.0) call erreur(5)
  321. return
  322. end
  323.  
  324.  
  325. subroutine mpircv(coldes,colcom,tag,bu)
  326.  
  327. C=======================================================================
  328. c routine mpiRcv
  329. c Wrapper pour la recepption de message avec MPI
  330. c Avantage : Lieu unique pour la gestion des erreurs
  331. c Passage a autre chose que MPI plus aise
  332. c Localisation de l'include mpi.h
  333. c
  334. C=======================================================================
  335. include 'mpif.h'
  336. -INC COCOLL
  337. integer mpiErr
  338. integer colcom
  339. integer colDes
  340. integer tag
  341. integer mpi_status(MPI_STATUS_SIZE)
  342. integer bufpos
  343. segment BUFFER
  344. character*1 ffer(lonBuf)
  345. endsegment
  346. pointeur bu.BUFFER
  347. mpiErr=0
  348. call ooosbl
  349. call MPI_PROBE(colDes-1, tag, colcom,
  350. & mpi_status, mpiErr)
  351. call oooubl
  352. if(mpiErr.ne.0) call erreur(5)
  353. C Allocation du buffer
  354. lonBuf=0
  355. call MPI_GET_COUNT(mpi_status, mpiTyPac,lonBuf ,mpiErr)
  356. if(mpiErr.ne.0) call erreur(5)
  357. segini bu
  358. bufPos = 0
  359. C Reception du message
  360. call ooosbl
  361. call MPI_RECV(bu.ffer,lonBuf,mpiTyPac,colDes-1,tag,
  362. & colcom, MPI_STATUS_IGNORE, mpiErr)
  363. call oooubl
  364.  
  365. if(mpiErr.ne.0) call erreur(5)
  366. return
  367. end
  368.  
  369.  
  370. subroutine mpirgc(rgc)
  371.  
  372. C=======================================================================
  373. c routine mpipme
  374. c Wrapper pour l'appel a MPI_Comm_rank
  375. c Avantage : Lieu unique pour la gestion des erreurs
  376. c Passage a autre chose que MPI plus aise
  377. c Localisation de l'include mpi.h
  378. c
  379. C=======================================================================
  380. include 'mpif.h'
  381. -INC COCOLL
  382. integer rgc
  383. integer mpiErr
  384. mpiErr=0
  385. call MPI_Comm_rank ( mpicomCa, rgc, mpiErr )
  386. if(mpiErr .ne. 0) call erreur(5)
  387. return
  388. end
  389.  
  390.  
  391. subroutine mpiupc(outbuf,outcount,bu,bufpos)
  392. C=======================================================================
  393. c routine mpiupC
  394. c Wrapper pour l'appel a mpi_unpack avec un tableau de caracteres en
  395. c argument.
  396. c Pour OK compilation sous AIX
  397. c Avantage : Lieu unique pour la gestion des erreurs
  398. c Passage a autre chose que MPI plus aise
  399. c Localisation de l'include mpi.h
  400. c
  401. C=======================================================================
  402. include 'mpif.h'
  403. -INC COCOLL
  404. character outbuf(2)
  405. integer outcount
  406. integer bufPos
  407. integer lonBuf
  408. integer mpiErr
  409. segment BUFFER
  410. character*1 ffer(lonBuf)
  411. endsegment
  412. pointeur bu.BUFFER
  413. lonBuf=bu.ffer(/2)
  414. mpiErr=0
  415. call MPI_UNPACK(bu.ffer, lonBuf,bufPos,outbuf,outcount
  416. & ,mpiTyCha, mpicomCa, mpiErr)
  417. if(mpiErr.ne.0) call erreur(5)
  418. c write(ioimp,*) 'Sortie mpiupc.eso'
  419. return
  420. end
  421.  
  422.  
  423. subroutine mpiupi(outbuf,outcount,bu,bufpos)
  424. C=======================================================================
  425. c routine mpiupC
  426. c Wrapper pour l'appel a mpi_unpack avec un tableau de caracteres en
  427. c argument.
  428. c Pour OK compilation sous AIX
  429. c Avantage : Lieu unique pour la gestion des erreurs
  430. c Passage a autre chose que MPI plus aise
  431. c Localisation de l'include mpi.h
  432. c
  433. C=======================================================================
  434. include 'mpif.h'
  435. -INC COCOLL
  436. integer outbuf(2)
  437. integer outcount
  438. integer bufPos
  439. integer lonBuf
  440. integer mpiErr
  441. segment BUFFER
  442. character*1 ffer(lonBuf)
  443. endsegment
  444. pointeur bu.BUFFER
  445. lonBuf=bu.ffer(/2)
  446. mpiErr=0
  447. call MPI_UNPACK(bu.ffer, lonBuf,bufPos,outbuf,outcount
  448. & ,mpiTyEnt, mpicomCa, mpiErr)
  449. if(mpiErr.ne.0) call erreur(5)
  450. c write(ioimp,*) 'Sortie mpiupi.eso'
  451. return
  452. end
  453.  
  454.  
  455. subroutine mpiupr(outbuf,outcount,bu,bufpos)
  456. C=======================================================================
  457. c routine mpiupC
  458. c Wrapper pour l'appel a mpi_unpack avec un tableau de caracteres en
  459. c argument.
  460. c Pour OK compilation sous AIX
  461. c Avantage : Lieu unique pour la gestion des erreurs
  462. c Passage a autre chose que MPI plus aise
  463. c Localisation de l'include mpi.h
  464. c
  465. C=======================================================================
  466. include 'mpif.h'
  467. -INC COCOLL
  468. real*8 outbuf(2)
  469. integer outcount
  470. integer bufPos
  471. integer lonBuf
  472. integer mpiErr
  473. segment BUFFER
  474. character*1 ffer(lonBuf)
  475. endsegment
  476. pointeur bu.BUFFER
  477. lonBuf=bu.ffer(/2)
  478. mpiErr=0
  479. call MPI_UNPACK(bu.ffer, lonBuf,bufPos,outbuf,outcount
  480. & ,mpiTyFlo, mpicomCa, mpiErr)
  481. if(mpiErr.ne.0) call erreur(5)
  482. c write(ioimp,*) 'Sortie mpiupr.eso'
  483. return
  484. end
  485. subroutine mpiicc(alead,blead,itag,interco)
  486.  
  487. C=======================================================================
  488. c routine mpiicc
  489. c Wrapper pour l'appel a MPI_Intercomm_create
  490. c Avantage : Lieu unique pour la gestion des erreurs
  491. c Passage a autre chose que MPI plus aise
  492. c Localisation de l'include mpi.h
  493. c
  494. C=======================================================================
  495. include 'mpif.h'
  496. -INC CCOPTIO
  497. -INC COCOLL
  498. integer mpiErr
  499. integer itag
  500. integer alead
  501. integer blead
  502. integer interco
  503. alead = 0
  504. interco = 0
  505. ierr = 0
  506. mpiErr = 0
  507.  
  508. CALL MPI_Intercomm_create(mpicomca, alead,
  509. & mpiComWo, blead, itag, interco,mpiErr)
  510.  
  511. if(mpiErr.ne.0) call erreur(5)
  512. if(iimpi.ge.6) then
  513. write(ioimp,*) 'Intercommunicateur cree'
  514. write(ioimp,*) 'Numero de comm', interco
  515. endif
  516.  
  517. return
  518. end
  519. %ELSE
  520. subroutine dummy_mpi
  521. entry mpienv
  522. entry mpifin
  523. entry mpihor
  524. entry mpiini
  525. entry mpinbc
  526. entry mpipac
  527. entry mpipai
  528. entry mpipar
  529. entry mpipme
  530. entry mpircv
  531. entry mpirgc
  532. entry mpiupc
  533. entry mpiupi
  534. entry mpiupr
  535. entry mpiicc
  536. mpiErr = 1
  537. write (6,*) 'Les appels MPI sont desactives .'
  538. call erreur(223)
  539. return
  540. end
  541.  
  542.  
  543. %ENDIF
  544.  
  545.  

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