MED fichier
UsesCase_MEDmesh_14.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 !* Use case 14 : read a 2D unstructured mesh with 2 polygons
19 !*
20 
22 
23  implicit none
24  include 'med.hf90'
25 
26  integer cret
27  integer fid
28 
29  ! mesh name
30  character*64 mname
31  ! file name
32  character*64 finame
33  ! mesh description
34  character*200 mdesc
35  ! mesh dim, space dim
36  integer mdim, sdim
37  !sorting type
38  integer stype
39  ! number of computing step
40  integer nstep
41  ! mesh type, coordinate axis type
42  integer mtype, atype
43  ! axis name, unit name
44  character*16 axname(2), unname(2)
45  ! time step unit
46  character*16 dtunit
47  ! coordinates
48  real*8, dimension(:), allocatable :: coords
49  integer nnodes
50  integer npoly
51  ! index size
52  integer isize
53  integer, dimension(:), allocatable :: index
54  ! connectivity
55  integer, dimension(:), allocatable :: conity
56  ! connectivity size
57  integer cosize
58  ! coordinate changement, geotransformation
59  integer coocha, geotra
60 
61  parameter(mname = "2D unstructured mesh")
62  parameter(finame = "UsesCase_MEDmesh_13.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  ! read mesh informations : mesh dimension, space dimension ...
72  call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, axname, unname, cret)
73  if (cret .ne. 0 ) then
74  print *,'Read mesh informations'
75  call efexit(-1)
76  endif
77  print *,"mesh name =", mname
78  print *,"space dim =", sdim
79  print *,"mesh dim =", mdim
80  print *,"mesh type =", mtype
81  print *,"mesh description =", mdesc
82  print *,"dt unit = ", dtunit
83  print *,"sorting type =", stype
84  print *,"number of computing step =", nstep
85  print *,"coordinates axis type =", atype
86  print *,"coordinates axis name =", axname
87  print *,"coordinates axis units =", unname
88 
89  ! read how many nodes in the mesh
90  call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_point1,med_coordinate,med_no_cmode,coocha,geotra,nnodes,cret)
91  if (cret .ne. 0 ) then
92  print *,'Read number of nodes ...'
93  call efexit(-1)
94  endif
95  print *,"Number of nodes =", nnodes
96 
97  ! we know that we only have MED_POLYGON celles in the mesh,
98  ! a real code working would check all MED geometry cell types ...
99 
100  ! How many polygon in the mesh in nodal connectivity mode
101  ! For the polygons, we get the size of array index
102  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_polygon,med_index_node,med_nodal,coocha,geotra,isize,cret)
103  if (cret .ne. 0 ) then
104  print *,'Read number of polygon ...'
105  call efexit(-1)
106  endif
107  npoly = isize - 1
108  print *,"Number of polygons =", npoly
109 
110  ! how many nodes for the polygon connectivity ?
111  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_polygon,med_connectivity,med_nodal,coocha,geotra,cosize,cret)
112  if (cret .ne. 0 ) then
113  print *,'Read connectivity size ...'
114  call efexit(-1)
115  endif
116  print *,"Read connectivity size ...", cosize
117 
118  ! read mesh nodes coordinates
119  allocate (coords(nnodes*sdim),stat=cret)
120  if (cret .ne. 0) then
121  print *,'Memory allocation'
122  call efexit(-1)
123  endif
124 
125  call mmhcor(fid,mname,med_no_dt,med_no_it,med_full_interlace,coords,cret)
126  if (cret .ne. 0 ) then
127  print *,'Read nodes coordinates ...'
128  call efexit(-1)
129  endif
130  print *,"Read nodes coordinates ...", coords
131 
132  deallocate(coords)
133 
134  ! read polygons connectivity mmhpgr
135  allocate (index(isize),stat=cret)
136  if (cret .ne. 0) then
137  print *,'Memory allocation'
138  call efexit(-1)
139  endif
140 
141  allocate (conity(cosize),stat=cret)
142  if (cret .ne. 0) then
143  print *,'Memory allocation'
144  call efexit(-1)
145  endif
146 
147  call mmhpgr(fid,mname,med_no_dt,med_no_it,med_cell,med_nodal,index,conity,cret)
148  if (cret .ne. 0 ) then
149  print *,'Read polygon connectivity ...'
150  call efexit(-1)
151  endif
152  print *,"Read polygon connectivity ...", conity
153 
154  deallocate(index)
155  deallocate(conity)
156 
157  ! ... we know that the family number of nodes and elements is 0, a real working would check ...
158 
159 ! close MED file
160  call mficlo(fid,cret)
161  if (cret .ne. 0 ) then
162  print *,'ERROR : close file'
163  call efexit(-1)
164  endif
165 
166 end program usescase_medmesh_14
subroutine mficlo(fid, cret)
Definition: medfile.f:80
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
program usescase_medmesh_14
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:130
subroutine mmhpgr(fid, name, numdt, numit, entype, cmode, index, con, cret)
Definition: medmesh.f:912
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