MED fichier: Fichier source de Parallel_test1.f90

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

Parallel_test1.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2019 EDF R&D, CEA/DEN
4 !* MED is free software: you can redistribute it and/or modify
5 !* it under the terms of the GNU Lesser General Public License as published by
6 !* the Free Software Foundation, either version 3 of the License, or
7 !* (at your option) any later version.
8 !*
9 !* MED is distributed in the hope that it will be useful,
10 !* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 !* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 !* GNU Lesser General Public License for more details.
13 !*
14 !* You should have received a copy of the GNU Lesser General Public License
15 !* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 !*
17
18
19 ! ******************************************************************************
20 ! * - Nom du fichier : Parallel_test1.f90
21 ! *
22 ! * - Description : lecture de champs de resultats MED en parallele
23 ! *
24 ! *****************************************************************************
25
26
27 program parallel_test1
28
29 implicit none
30 include 'med.hf90'
31 include 'mpif.h'
32
33 integer ret, fid
34 integer USER_INTERLACE,USER_MODE
35 integer*4 com,ioe,rank,nprocs
36 integer info,com4_8
37 integer nent
38 integer nvent
39 integer ncent
40 integer start, stride, count, bsize, lbsize, resd
41 character*64 :: pflname
42 integer*8 flt(1)
43 real*8, allocatable,dimension(:) :: val
44 integer i,j,k
45
46 com4_8=mpi_comm_world
47 info=mpi_info_null
48
49 call mpi_init(ioe)
50 call mpi_comm_size(mpi_comm_world,nprocs,ioe)
51 call mpi_comm_rank(mpi_comm_world,rank,ioe)
52
53 ! ** ouverture du fichier **
54 call mpfope(fid, 'NENT-942_NVAL-008_NCST-007.med', med_acc_rdonly,com4_8, info, ret)
55
56 if (ret .ne. 0) then
57 print *,"Erreur à l'ouverture du fichier"
58 print *,"Process n° ",rank,"/",nprocs," ret :",ret
59 call efexit(ret)
60 endif
61
62 nent = 942
63 nvent = 008
64 ncent = 007
65 pflname = ""
66 bsize = nent/nprocs
67 ! Etant donné que l'on affecte qu'un bloc par processus lbsize vaut toujours 0
68 lbsize = 0
69 start = rank*(bsize)+1
70 count = 1
71 stride = bsize
72 resd = 0
73 if (rank.eq.(nprocs-1) ) then
74 resd = nent-(nprocs*bsize)
75 bsize = bsize + resd
76 endif
77 print *,"myrank :",rank," resd", resd," bsize ",bsize," lbsize",lbsize
78
79 call mfrall(1,flt,ret)
80 if (ret .ne. 0) then
81 print *,"Erreur à l'allocation du filtre"
82 print *,"Process n° ",rank,"/",nprocs," ret :",ret
83 call efexit(ret)
84 endif
85
86 call mfrblc (fid, nent, nvent, ncent, &
87 & med_all_constituent, med_full_interlace,med_compact_stmode ,med_allentities_profile, &
88 & start, stride, count, bsize, lbsize, flt, ret)
89
90 if (ret .ne. 0) then
91 print *,"Erreur à la définition du filtre"
92 print *,"Process n° ",rank,"/",nprocs," ret :",ret
93 call efexit(ret)
94 endif
95
96 allocate(val(bsize*nvent*ncent),stat=ret)
97 val(:)=-1.1
98
99 call mfdrar ( fid, "NENT-942_NVAL-008_NCST-007_NBL-001",&
100 & med_no_dt, med_no_it, med_cell, med_tria6,&
101 & flt(1), val, ret )
102 if (ret .ne. 0) then
103 print *,"Erreur à la lecture du champ résultat"
104 print *,"Process n° ",rank,"/",nprocs," ret :",ret
105 call efexit(ret)
106 endif
107
108 open(40+rank)
109 do i=0,bsize-1
110 do j=0,nvent-1
111 do k=0,ncent-1
112 write(40+rank,'(1X,F10.3,1X)',advance='NO') val(i*(ncent*nvent)+j*ncent+k+1)
113 enddo
114 write(40+rank,'(A)') "/"
115 enddo
116 write(40+rank,'(A)') "//"
117 enddo
118 close(40+rank)
119
120 deallocate(val)
121
122 call mfrdea(1,flt,ret)
123 if (ret .ne. 0) then
124 print *,"Erreur à la desallocation du filtre"
125 print *,"Process n° ",rank,"/",nprocs," ret :",ret
126 call efexit(ret)
127 endif
128
129 print *,"Process n° ",rank,"/",nprocs," ret :",ret
130
131 ! call MPI_BARRIER(com,ioe)
132
133 call mficlo(fid,ret)
134
135 call mpi_finalize(ioe)
136
137 end program parallel_test1
mfdrar
subroutine mfdrar(fid, fname, numdt, numit, etype, gtype, flt, val, cret)
Definition: medfield.f:550
mfrdea
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:60
mfrall
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:44
parallel_test1
program parallel_test1
Definition: Parallel_test1.f90:27
mpfope
subroutine mpfope(fid, name, access, com, info, cret)
Definition: medparfile.f:19
mfrblc
subroutine mfrblc(fid, nent, nvent, ncent, cs, swm, stm, pname, start, stride, count, bsize, lbsize, flt, cret)
Definition: medfilter.f:78
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82