MED fichier
UsesCase_MEDmesh_11.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2021 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 !* Use case 11 : read a 2D unstructured mesh with 15 nodes, 8 triangular cells, 4 quadragular cells with
20 !* nodes families
21 !*
22 
24 
25  implicit none
26  include 'med.hf90'
27 
28  integer cret
29  integer*8 fid
30 
31  ! space dim, mesh dim
32  integer sdim, mdim
33  ! axis name, unit name
34  character*16 axname(2), unname(2)
35  ! time step unit
36  character*16 dtunit
37  ! mesh name, family name, file name
38  character*64 mname, fyname, finame
39  ! mesh type, sorting type, coordinate axis type
40  integer mtype, stype, atype
41  ! number of family, number of group, family number
42  integer nfam, ngro, fnum
43  ! number of computing step
44  integer nstep
45  ! coordinate changement, geotransformation
46  integer coocha, geotra
47  ! number of family numbers
48  integer nfanbrs
49  ! coordinates
50  real*8, dimension(:), allocatable :: coords
51  integer nnodes, ntria3, nquad4
52  ! triangular and quadrangular cells connectivity
53  ! integer tricon(24), quacon(16)
54  integer, dimension(:), allocatable :: tricon, quacon
55  integer n
56  ! family numbers
57  ! integer fanbrs(15)
58  integer, dimension (:), allocatable :: fanbrs
59  ! comment 1, mesh description
60  character*200 cmt1, mdesc
61  ! group name
62  character*80, dimension (:), allocatable :: gname
63 
64  parameter(mname = "2D unstructured mesh")
65  parameter(finame = "UsesCase_MEDmesh_10.med")
66 
67  ! open MED file with READ ONLY access mode
68  call mfiope(fid, finame, med_acc_rdonly, cret)
69  if (cret .ne. 0 ) then
70  print *,'ERROR : open file'
71  call efexit(-1)
72  endif
73 
74  ! ... we know that the MED file has only one mesh,
75  ! a real code working would check ...
76 
77  ! read mesh informations : mesh dimension, space dimension ...
78  call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, axname, unname, cret)
79  if (cret .ne. 0 ) then
80  print *,'Read mesh informations'
81  call efexit(-1)
82  endif
83  print *,"mesh name =", mname
84  print *,"space dim =", sdim
85  print *,"mesh dim =", mdim
86  print *,"mesh type =", mtype
87  print *,"mesh description =", mdesc
88  print *,"dt unit = ", dtunit
89  print *,"sorting type =", stype
90  print *,"number of computing step =", nstep
91  print *,"coordinates axis type =", atype
92  print *,"coordinates axis name =", axname
93  print *,"coordinates axis units =", unname
94 
95  ! read how many nodes in the mesh
96  call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_no_geotype,med_coordinate,med_no_cmode,coocha,geotra,nnodes,cret)
97  if (cret .ne. 0 ) then
98  print *,'Read number of nodes ...'
99  call efexit(-1)
100  endif
101  print *,"Number of nodes =", nnodes
102 
103  ! ... we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh,
104  ! a real code working would check all MED geometry cell types ...
105 
106  ! read how many triangular cells in the mesh
107  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_nodal,coocha,geotra,ntria3,cret)
108  if (cret .ne. 0 ) then
109  print *,'Read number of MED_TRIA3 ...'
110  call efexit(-1)
111  endif
112  print *,"Number of MED_TRIA3 =", ntria3
113 
114  ! read how many quadrangular cells in the mesh
115  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_connectivity,med_nodal,coocha,geotra,nquad4,cret)
116  if (cret .ne. 0 ) then
117  print *,'Read number of MED_QUAD4 ...'
118  call efexit(-1)
119  endif
120  print *,"Number of MED_QUAD4 =", nquad4
121 
122  ! read mesh nodes coordinates
123  allocate ( coords(nnodes*sdim),stat=cret )
124  if (cret .ne. 0) then
125  print *,'Memory allocation'
126  call efexit(-1)
127  endif
128 
129  call mmhcor(fid,mname,med_no_dt,med_no_it,med_full_interlace,coords,cret)
130  print *,cret
131  if (cret .ne. 0 ) then
132  print *,'Read nodes coordinates'
133  call efexit(-1)
134  endif
135  print *,"Nodes coordinates =", coords
136  deallocate(coords)
137 
138  ! read cells connectivity in the mesh
139  allocate ( tricon(ntria3*3),stat=cret )
140  if (cret .ne. 0) then
141  print *,'Memory allocation'
142  call efexit(-1)
143  endif
144 
145  call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_nodal,med_full_interlace,tricon,cret)
146  if (cret .ne. 0 ) then
147  print *,'Read MED_TRIA3 connectivity'
148  call efexit(-1)
149  endif
150  print *,"MED_TRIA3 connectivity =", tricon
151  deallocate(tricon)
152 
153  ! read cells connectivity in the mesh
154  allocate ( quacon(nquad4*4),stat=cret )
155  if (cret .ne. 0) then
156  print *,'Memory allocation'
157  call efexit(-1)
158  endif
159 
160  call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_nodal,med_full_interlace,quacon,cret)
161  if (cret .ne. 0 ) then
162  print *,'Read MED_QUAD4 connectivity'
163  call efexit(-1)
164  endif
165  print *,"MED_QUAD4 connectivity =", quacon
166  deallocate(quacon)
167 
168  ! read families of entities
169  call mfanfa(fid,mname,nfam,cret)
170  if (cret .ne. 0 ) then
171  print *,'Read number of family'
172  call efexit(-1)
173  endif
174  print *,"Number of family =", nfam
175 
176  do n=1,nfam
177 
178  call mfanfg(fid,mname,n,ngro,cret)
179  if (cret .ne. 0 ) then
180  print *,'Read number of group in a family'
181  call efexit(-1)
182  endif
183  print *,"Number of group in family =", ngro
184 
185  if (ngro .gt. 0) then
186  allocate ( gname((ngro)),stat=cret )
187  if (cret .ne. 0) then
188  print *,'Memory allocation'
189  call efexit(-1)
190  endif
191  call mfafai(fid,mname,n,fyname,fnum,gname,cret)
192  if (cret .ne. 0) then
193  print *,'Read group names'
194  call efexit(-1)
195  endif
196  print *,"Group name =", gname
197  deallocate(gname)
198  endif
199 
200  enddo
201 
202  ! read family numbers for nodes
203  ! By convention, if there is no numbers in the file, it means that 0 is the family
204  ! number of all nodes
205  call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_none,med_family_number,med_no_cmode,coocha,geotra,nfanbrs,cret)
206  if (cret .ne. 0) then
207  print *,'Check family numbers nodes'
208  call efexit(-1)
209  endif
210  allocate ( fanbrs(nnodes),stat=cret )
211  if (cret .ne. 0) then
212  print *,'Memory allocation'
213  call efexit(-1)
214  endif
215  if (nfanbrs .ne. 0) then
216  call mmhfnr(fid,mname,med_no_dt,med_no_it,med_node, med_none,fanbrs,cret)
217  if (cret .ne. 0) then
218  print *,'Read family numbers nodes'
219  call efexit(-1)
220  endif
221  else
222  do n=1,nnodes
223  fanbrs(n) = 0
224  enddo
225  endif
226  print *, 'Family numbers for nodes :', fanbrs
227  deallocate(fanbrs)
228 
229  ! read family numbers for cells
230  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_family_number,med_nodal,coocha,geotra,nfanbrs,cret)
231  if (cret .ne. 0) then
232  print *,'Check family numbers tria3'
233  call efexit(-1)
234  endif
235  allocate ( fanbrs(ntria3),stat=cret )
236  if (cret .ne. 0) then
237  print *,'Memory allocation'
238  call efexit(-1)
239  endif
240 
241  if (nfanbrs .ne. 0) then
242  call mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,fanbrs,cret)
243  if (cret .ne. 0) then
244  print *,'Read family numbers tria3'
245  call efexit(-1)
246  endif
247  else
248  do n=1,ntria3
249  fanbrs(n) = 0
250  enddo
251  endif
252  print *, 'Family numbers for tria cells :', fanbrs
253  deallocate(fanbrs)
254 
255  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_family_number,med_nodal,coocha,geotra,nfanbrs,cret)
256  if (cret .ne. 0) then
257  print *,'Check family numbers quad4'
258  call efexit(-1)
259  endif
260  allocate ( fanbrs(nquad4),stat=cret )
261  if (cret .ne. 0) then
262  print *,'Memory allocation'
263  call efexit(-1)
264  endif
265  if (nfanbrs .ne. 0) then
266  call mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,fanbrs,cret)
267  if (cret .ne. 0) then
268  print *,'Read family numbers quad4'
269  call efexit(-1)
270  endif
271  else
272  do n=1,nquad4
273  fanbrs(n) = 0
274  enddo
275  endif
276  print *, 'Family numbers for quad cells :', fanbrs
277  deallocate(fanbrs)
278 
279 ! close MED file
280  call mficlo(fid,cret)
281  if (cret .ne. 0 ) then
282  print *,'ERROR : close file'
283  call efexit(-1)
284  endif
285 
286 end program usescase_medmesh_11
287 
mmhnme
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 étape de calcul donnée.
Definition: medmesh.f:551
mfanfg
subroutine mfanfg(fid, maa, it, n, cret)
Cette routine permet de lire le nombre de groupe dans une famille.
Definition: medfamily.f:61
mmhfnr
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:487
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:320
mfanfa
subroutine mfanfa(fid, maa, n, cret)
Cette routine permet de lire le nombre de famille dans un maillage.
Definition: medfamily.f:38
mmhmin
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage en précisant son nom.
Definition: medmesh.f:130
mfafai
subroutine mfafai(fid, maa, ind, fam, num, gro, cret)
Cette routine permet de lire les informations relatives à une famille d'un maillage.
Definition: medfamily.f:84
usescase_medmesh_11
program usescase_medmesh_11
Definition: UsesCase_MEDmesh_11.f90:23
mmhcyr
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:600