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