Parallel_test1.f90
Aller à la documentation de ce fichier.
!* This file is part of MED.
!*
!* COPYRIGHT (C) 1999 - 2021 EDF R&D, CEA/DEN
!* MED is free software: you can redistribute it and/or modify
!* it under the terms of the GNU Lesser General Public License as published by
!* the Free Software Foundation, either version 3 of the License, or
!* (at your option) any later version.
!*
!* MED is distributed in the hope that it will be useful,
!* but WITHOUT ANY WARRANTY; without even the implied warranty of
!* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
!* GNU Lesser General Public License for more details.
!*
!* You should have received a copy of the GNU Lesser General Public License
!* along with MED. If not, see <http://www.gnu.org/licenses/>.
!*
! ******************************************************************************
! * - Nom du fichier : Parallel_test1.f90
! *
! * - Description : lecture de champs de resultats MED en parallele
! *
! *****************************************************************************
program parallel_test1
implicit none
include 'med.hf90'
include 'mpif.h'
integer ret, fid
integer user_interlace,user_mode
integer*4 com,ioe,rank,nprocs
integer info,com4_8
integer nent
integer nvent
integer ncent
integer start, stride, count, bsize, lbsize, resd
character*64 :: pflname
integer*8 flt(1)
real*8, allocatable,dimension(:) :: val
integer i,j,k
com4_8=mpi_comm_world
info=mpi_info_null
call mpi_init(ioe)
call mpi_comm_size(mpi_comm_world,nprocs,ioe)
call mpi_comm_rank(mpi_comm_world,rank,ioe)
! ** ouverture du fichier **
call mpfope(fid, 'NENT-942_NVAL-008_NCST-007.med', med_acc_rdonly,com4_8, info, ret)
if (ret .ne. 0) then
print *,"Erreur à l'ouverture du fichier"
print *,"Process n° ",rank,"/",nprocs," ret :",ret
call efexit(ret)
endif
nent = 942
nvent = 008
ncent = 007
pflname = ""
bsize = nent/nprocs
! Etant donné que l'on affecte qu'un bloc par processus lbsize vaut toujours 0
lbsize = 0
start = rank*(bsize)+1
count = 1
stride = bsize
resd = 0
if (rank.eq.(nprocs-1) ) then
resd = nent-(nprocs*bsize)
bsize = bsize + resd
endif
print *,"myrank :",rank," resd", resd," bsize ",bsize," lbsize",lbsize
call mfrall(1,flt,ret)
if (ret .ne. 0) then
print *,"Erreur à l'allocation du filtre"
print *,"Process n° ",rank,"/",nprocs," ret :",ret
call efexit(ret)
endif
call mfrblc (fid, nent, nvent, ncent, &
& med_all_constituent, med_full_interlace,med_compact_stmode ,med_allentities_profile, &
& start, stride, count, bsize, lbsize, flt, ret)
if (ret .ne. 0) then
print *,"Erreur à la définition du filtre"
print *,"Process n° ",rank,"/",nprocs," ret :",ret
call efexit(ret)
endif
allocate(val(bsize*nvent*ncent),stat=ret)
val(:)=-1.1
call mfdrar ( fid, "NENT-942_NVAL-008_NCST-007_NBL-001",&
& med_no_dt, med_no_it, med_cell, med_tria6,&
& flt(1), val, ret )
if (ret .ne. 0) then
print *,"Erreur à la lecture du champ résultat"
print *,"Process n° ",rank,"/",nprocs," ret :",ret
call efexit(ret)
endif
open(40+rank)
do i=0,bsize-1
do j=0,nvent-1
do k=0,ncent-1
write(40+rank,'(1X,F10.3,1X)',advance='NO') val(i*(ncent*nvent)+j*ncent+k+1)
enddo
write(40+rank,'(A)') "/"
enddo
write(40+rank,'(A)') "//"
enddo
close(40+rank)
deallocate(val)
call mfrdea(1,flt,ret)
if (ret .ne. 0) then
print *,"Erreur à la desallocation du filtre"
print *,"Process n° ",rank,"/",nprocs," ret :",ret
call efexit(ret)
endif
print *,"Process n° ",rank,"/",nprocs," ret :",ret
! call MPI_BARRIER(com,ioe)
call mficlo(fid,ret)
call mpi_finalize(ioe)
end program parallel_test1
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:44
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mpfope
subroutine mpfope(fid, name, access, com, info, cret)
Ouverture d'un fichier MED pour une utilisation parallèle.
Definition: medparfile.f:19
mfrdea
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:60
mfrblc
subroutine mfrblc(fid, nent, nvent, ncent, cs, swm, stm, pname, start, stride, count, bsize, lbsize, flt, cret)
Crée un filtre en selectionnant par blocs les entités pour lesquelles on veut lire/écrire des valeurs...
Definition: medfilter.f:78
mfdrar
subroutine mfdrar(fid, fname, numdt, numit, etype, gtype, flt, val, cret)
Cette fonction permet de lire les valeurs d'un champ définies sur des entités d'un maillage pour une ...
Definition: medfield.f:550
parallel_test1
program parallel_test1
Definition: Parallel_test1.f90:27