MED fichier: Fichier source de UsesCase_MEDmesh_11.f90

MED fichier

UsesCase_MEDmesh_11.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 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
23 program usescase_medmesh_11
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
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
mfanfa
subroutine mfanfa(fid, maa, n, cret)
Cette routine permet de lire le nombre de famille dans un maillage.
Definition: medfamily.f:38
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
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
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
mfanfg
subroutine mfanfg(fid, maa, it, n, cret)
Cette routine permet de lire le nombre de groupe dans une famille.
Definition: medfamily.f:61
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
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42