MED fichier: Fichier source de UsesCase_MEDmesh_11.f90

MED fichier

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

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