MED fichier
UsesCase_MEDmesh_11.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 !* 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 
subroutine mmhfnr(fid, name, numdt, numit, entype, geotype, num, cret)
Definition: medmesh.f:487
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:130
subroutine mficlo(fid, cret)
Definition: medfile.f:82
program usescase_medmesh_11
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
subroutine mfanfa(fid, maa, n, cret)
Definition: medfamily.f:38
subroutine mfanfg(fid, maa, it, n, cret)
Definition: medfamily.f:61
subroutine mfafai(fid, maa, ind, fam, num, gro, cret)
Definition: medfamily.f:84
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551