Parallel_test1.f90

Aller à la documentation de ce fichier.
00001 !*  This file is part of MED.
00002 !*
00003 !*  COPYRIGHT (C) 1999 - 2015  EDF R&D, CEA/DEN
00004 !*  MED is free software: you can redistribute it and/or modify
00005 !*  it under the terms of the GNU Lesser General Public License as published by
00006 !*  the Free Software Foundation, either version 3 of the License, or
00007 !*  (at your option) any later version.
00008 !*
00009 !*  MED is distributed in the hope that it will be useful,
00010 !*  but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 !*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00012 !*  GNU Lesser General Public License for more details.
00013 !*
00014 !*  You should have received a copy of the GNU Lesser General Public License
00015 !*  along with MED.  If not, see <http://www.gnu.org/licenses/>.
00016 !*
00017 
00018 
00019 ! ******************************************************************************
00020 ! * - Nom du fichier : Parallel_test1.f90
00021 ! *
00022 ! * - Description : lecture de champs de resultats MED en parallele
00023 ! *
00024 ! ***************************************************************************** 
00025 
00026 
00027 program parallel_test1
00028 
00029   implicit none
00030   include 'med.hf90'
00031   include 'mpif.h'
00032 
00033   integer  ret, fid
00034   integer  USER_INTERLACE,USER_MODE
00035   integer*4 com,ioe,rank,nprocs
00036   integer  info,com4_8
00037   integer  nent 
00038   integer  nvent
00039   integer  ncent
00040   integer  start, stride, count, bsize, lbsize, resd
00041   character*64 :: pflname
00042   integer*8 flt(1)
00043   real*8,   allocatable,dimension(:) :: val
00044   integer   i,j,k
00045 
00046   com4_8=MPI_COMM_WORLD
00047   info=MPI_INFO_NULL
00048 
00049   call MPI_INIT(ioe)
00050   call MPI_COMM_SIZE(MPI_COMM_WORLD,nprocs,ioe)
00051   call MPI_COMM_RANK(MPI_COMM_WORLD,rank,ioe)
00052 
00053   !  ** ouverture du fichier **
00054   call mpfope(fid, 'NENT-942_NVAL-008_NCST-007.med', MED_ACC_RDONLY,com4_8, info, ret)
00055 
00056   if (ret .ne. 0) then 
00057    print *,"Erreur à l'ouverture du fichier"
00058    print *,"Process n° ",rank,"/",nprocs," ret :",ret
00059    call efexit(ret)
00060   endif
00061 
00062   nent     = 942
00063   nvent    = 008
00064   ncent    = 007
00065   pflname  = ""
00066   bsize  = nent/nprocs
00067 ! Etant donné que l'on affecte qu'un bloc par processus lbsize vaut toujours 0
00068   lbsize = 0
00069   start  = rank*(bsize)+1
00070   count  = 1
00071   stride = bsize
00072   resd = 0
00073   if (rank.eq.(nprocs-1) ) then
00074      resd   = nent-(nprocs*bsize)
00075      bsize = bsize + resd
00076   endif
00077   print *,"myrank :",rank," resd", resd," bsize ",bsize," lbsize",lbsize
00078 
00079   call mfrall(1,flt,ret)
00080   if (ret .ne. 0) then 
00081    print *,"Erreur à l'allocation du filtre"
00082    print *,"Process n° ",rank,"/",nprocs," ret :",ret
00083    call efexit(ret)
00084   endif
00085 
00086   call mfrblc (fid, nent, nvent, ncent, &
00087        & MED_ALL_CONSTITUENT, MED_FULL_INTERLACE,MED_COMPACT_STMODE ,MED_ALLENTITIES_PROFILE, &
00088        & start, stride, count, bsize, lbsize, flt, ret)
00089 
00090   if (ret .ne. 0) then 
00091    print *,"Erreur à la définition du filtre"
00092    print *,"Process n° ",rank,"/",nprocs," ret :",ret
00093    call efexit(ret)
00094   endif
00095 
00096   allocate(val(bsize*nvent*ncent),STAT=ret) 
00097   val(:)=-1.1
00098 
00099   call mfdrar   ( fid, "NENT-942_NVAL-008_NCST-007_NBL-001",&
00100        & MED_NO_DT, MED_NO_IT, MED_CELL, MED_TRIA6,& 
00101        & flt(1), val, ret )
00102   if (ret .ne. 0) then 
00103    print *,"Erreur à la lecture du champ résultat"
00104    print *,"Process n° ",rank,"/",nprocs," ret :",ret
00105    call efexit(ret)
00106   endif
00107 
00108   open(40+rank)  
00109   do i=0,bsize-1
00110      do j=0,nvent-1
00111         do k=0,ncent-1
00112            write(40+rank,'(1X,F10.3,1X)',ADVANCE='NO') val(i*(ncent*nvent)+j*ncent+k+1)
00113         enddo
00114         write(40+rank,'(A)') "/"
00115      enddo
00116      write(40+rank,'(A)') "//"
00117   enddo
00118   close(40+rank)
00119 
00120   deallocate(val)
00121 
00122   call mfrdea(1,flt,ret)
00123   if (ret .ne. 0) then 
00124    print *,"Erreur à la desallocation du filtre"
00125    print *,"Process n° ",rank,"/",nprocs," ret :",ret
00126    call efexit(ret)
00127   endif
00128 
00129   print *,"Process n° ",rank,"/",nprocs," ret :",ret
00130 
00131 !  call MPI_BARRIER(com,ioe)
00132 
00133   call mficlo(fid,ret)
00134 
00135   call MPI_FINALIZE(ioe)
00136 
00137 end program parallel_test1

Généré le Thu Oct 8 14:26:16 2015 pour MED fichier par  doxygen 1.6.1