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