MED fichier
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 
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 
program usescase_medmesh_11
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
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
subroutine mfanfa(fid, maa, n, cret)
Cette routine permet de lire le nombre de famille dans un maillage.
Definition: medfamily.f:37
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
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
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
subroutine mfanfg(fid, maa, it, n, cret)
Cette routine permet de lire le nombre de groupe dans une famille.
Definition: medfamily.f:59
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
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41