MED fichier
test7.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2017 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 ! * - Nom du fichier : test7.f90
20 ! *
21 ! * - Description : lecture des elements du maillage MED ecrits par test6
22 ! *
23 ! ******************************************************************************
24  program test7
25 
26  implicit none
27  include 'med.hf90'
28 !
29 !
30  integer cret, ret, fid
31 
32  integer nse2
33  integer, allocatable, dimension (:) :: se2,se21
34  character*16, allocatable, dimension (:) :: nomse2
35  integer, allocatable, dimension (:) :: numse2,nufase2
36 
37  integer ntr3
38  integer, allocatable, dimension (:) :: tr3
39  character*16, allocatable, dimension (:) :: nomtr3
40  integer, allocatable, dimension (:) :: numtr3,nufatr3
41 
42 ! ** nom du maillage de longueur maxi MED_TAILLE_NOM **
43  character*64 :: maa
44  character*200 :: desc
45  integer :: mdim,edim,nstep,stype,atype
46  logical inoele,inuele
47  integer, parameter :: profil (2) = (/ 2,3 /)
48  integer type
49  integer tse2,ttr3, i
50  character*16 nomcoo(2)
51  character*16 unicoo(2)
52  character*16 dtunit
53  integer :: chgt,tsf
54  integer flta(1)
55  integer*8 flt(1)
56 
57 ! ** Ouverture du fichier test6.med en lecture seule **
58  call mfiope(fid,'test6.med',med_acc_rdonly, cret)
59  print *,cret
60 
61 ! ** Lecture des infos concernant le premier maillage **
62  if (cret.eq.0) then
63  call mmhmii(fid,1,maa,edim,mdim,type,desc,dtunit,stype,nstep,atype,nomcoo,unicoo,cret)
64  print *,"Maillage de nom : ",maa," et de dimension :", mdim
65  endif
66  if (cret.ne.0) then
67  call efexit(-1)
68  endif
69 ! ** Combien de segments et de triangles **
70  if (cret.eq.0) then
71  nse2 = 0
72  call mmhnme(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_connectivity,med_descending,chgt,tsf,nse2,cret)
73  endif
74  if (cret.ne.0) then
75  call efexit(-1)
76  endif
77 
78  if (cret.eq.0) then
79  ntr3 = 0
80  call mmhnme(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_descending,chgt,tsf,ntr3,cret)
81  endif
82  if (cret.ne.0) then
83  call efexit(-1)
84  endif
85 
86  if (cret.eq.0) then
87  print *,"Nombre de MED_SEG2 : ",nse2," - nombre de MED_TRIA3 : ",ntr3
88  endif
89 
90 ! ** Allocations memoire **
91  tse2 = 2
92  allocate (se2(tse2*nse2),se21(tse2*nse2),nomse2(nse2),numse2(nse2), nufase2(nse2),stat=ret )
93  se2(:)=0; se21(:)=0
94 ! print *,ret
95 
96  ttr3 = 3
97  allocate (tr3(ntr3*ttr3), nomtr3(ntr3), numtr3(ntr3),nufatr3(ntr3),stat=ret )
98  tr3(:)=0
99 ! print *,ret
100 
101 
102 ! ** Lecture de la connectivite des segments **
103  if (cret.eq.0) then
104  call mmhcyr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending,med_full_interlace,se2,cret)
105  endif
106  if (cret.ne.0) then
107  call efexit(-1)
108  endif
109  print *,se2
110 
111 ! ** Lecture de de la composante 2 de la connectivite des segments **
112 ! ** On cree un filtre associe
113  if (cret .eq. 0) then
114  call mfrall(1,flt,cret)
115  endif
116  if (cret.ne.0) then
117  call efexit(-1)
118  endif
119 
120 ! ** on initialise le filtre pour lire uniquement la deuxième composante.
121  if (cret .eq. 0) then
122  call mfrcre(fid,nse2,1,edim,2,med_full_interlace,med_global_stmode, &
123  med_no_profile,med_undef_size,flta,flt(1),cret)
124  endif
125  if (cret.ne.0) then
126  call efexit(-1)
127  endif
128 
129 ! ** Lecture des composantes n°2 des segments
130  if (cret.eq.0) then
131  call mmhyar(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,med_descending, &
132  flt(1),se21,cret)
133  endif
134  if (cret.ne.0) then
135  call efexit(-1)
136  endif
137  print *,se21
138 
139 ! ** On desalloue le filtre
140  if (cret .eq. 0) then
141  call mfrdea(1,flt,cret)
142  endif
143  if (cret.ne.0) then
144  call efexit(-1)
145  endif
146 
147 ! ** Lecture (optionnelle) des noms des segments **
148  if (cret.eq.0) then
149  call mmhear(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nomse2,cret)
150  endif
151 
152  if (ret <0) then
153  inoele = .false.
154  else
155  inoele = .true.
156  endif
157 
158 ! ** Lecture (optionnelle) des numeros des segments **
159  if (cret.eq.0) then
160  call mmhenr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,numse2,cret)
161  endif
162 
163  if (ret <0) then
164  inuele = .false.
165  else
166  inuele = .true.
167  endif
168 
169 ! ** Lecture des numeros des familles des segments **
170  if (cret.eq.0) then
171  call mmhfnr(fid,maa,med_no_dt,med_no_it,med_descending_edge,med_seg2,nufase2,cret)
172  endif
173  if (cret.ne.0) then
174  call efexit(-1)
175  endif
176 
177 ! ** Lecture de la connectivite des triangles sans profil **
178  if (cret.eq.0) then
179  call mmhcyr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,med_descending,med_no_interlace,tr3,cret)
180  endif
181  if (cret.ne.0) then
182  call efexit(-1)
183  endif
184 
185 ! ** Lecture (optionnelle) des noms des triangles **
186  if (cret.eq.0) then
187  call mmhear(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nomtr3,cret)
188  endif
189 
190  if (ret <0) then
191  inoele = .false.
192  else
193  inoele = .true.
194  endif
195  print *,cret
196 
197 ! ** Lecture (optionnelle) des numeros des segments **
198  if (cret.eq.0) then
199  call mmhenr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,numtr3,cret)
200  endif
201 
202  if (ret <0) then
203  inuele = .false.
204  else
205  inuele = .true.
206  endif
207  print *,cret
208 
209 ! ** Lecture des numeros des familles des segments **
210  if (cret.eq.0) then
211  call mmhfnr(fid,maa,med_no_dt,med_no_it,med_cell,med_tria3,nufatr3,cret)
212  endif
213  print *,cret
214 
215 ! ** Fermeture du fichier **
216  call mficlo(fid,cret)
217  if (cret.ne.0) then
218  call efexit(-1)
219  endif
220 
221 ! ** Affichage des resulats **
222  if (cret.eq.0) then
223 
224  print *,"Connectivite des segments : "
225  print *, se2
226 
227  if (inoele) then
228  print *,"Noms des segments :"
229  print *,nomse2
230  endif
231 
232  if (inuele) then
233  print *,"Numeros des segments :"
234  print *,numse2
235  endif
236 
237  print *,"Numeros des familles des segments :"
238  print *,nufase2
239 
240  print *,"Connectivite des triangles :"
241  print *,tr3
242 
243  if (inoele) then
244  print *,"Noms des triangles :"
245  print *,nomtr3
246  endif
247 
248  if (inuele) then
249  print *,"Numeros des triangles :"
250  print *,numtr3
251  endif
252 
253  print *,"Numeros des familles des triangles :"
254  print *,nufatr3
255 
256  endif
257 
258 ! ** Nettoyage memoire **
259  deallocate (se2,se21,nomse2,numse2,nufase2,tr3,nomtr3,numtr3,nufatr3)
260 
261 ! ** Code retour
262  call efexit(cret)
263 
264  end program test7
265 
subroutine mmhear(fid, mname, numdt, numit, entype, geotype, ename, cret)
Cette routine permet de lire les noms d'un type d'entité d'un maillage.
Definition: medmesh.f:504
subroutine mmhyar(fid, name, numdt, numit, entype, geotype, cmode, flt, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
Definition: medmesh.f:829
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
program test7
Definition: test7.f90:24
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une séquence de calcul donnée...
Definition: medmesh.f:525
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage dans un fichier.
Definition: medmesh.f:106
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet la lecture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:464
subroutine mfrdea(nflt, flt, cret)
Desalloue un tableau de filtre de taille nfilter.
Definition: medfilter.f:59
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
Definition: medmesh.f:572
subroutine mfrcre(fid, nent, nvent, ncent, cs, swm, stm, pname, fltas, flta, flt, cret)
Crée une selection d'entités grâce a un tableau d'index filterarray de taille filterarraysize. Initialisé en sortie de fonction, le filtre filter sera utilisé pour lire/écrire des valeurs associées à ces entités. Ces valeurs peuvent être des coordonnées, des connectivités des valeurs de champs résultats mais aussi des numéros de familles, des noms ou numéros optionnels.
Definition: medfilter.f:22
subroutine mfrall(nflt, flt, cret)
Alloue un tableau de filtres de taille nfilter.
Definition: medfilter.f:43
#define false
Definition: libmedimport.c:36
#define true
Definition: libmedimport.c:37
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
subroutine mmhenr(fid, name, numdt, numit, entype, geotype, num, cret)
Cette routine permet de lire les numéros d'un type d'entité d'un maillage.
Definition: medmesh.f:424