# Parallel_test1.f90

Aller à la documentation de ce fichier.

    00001 !*  This file is part of MED.
    00002 !*
    00003 !*  COPYRIGHT (C) 1999 - 2012  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