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