Télécharger la plaquette Cast3M


fr en

Télécharger appmpi.eso

Retour à la liste

Numérotation des lignes : 

appmpi

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

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