MED fichier
UsesCase_MEDmesh_7.f90
Aller à la documentation de ce fichier.
1!* This file is part of MED.
2!*
3!* COPYRIGHT (C) 1999 - 2020 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 7 : read a 2D unstructured mesh with nodes coordinates modifications
20!*
21
23
24 implicit none
25 include 'med.hf90'
26
27 integer cret
28 integer*8 fid
29
30 ! mesh name
31 character(MED_NAME_SIZE) :: mname = "2D unstructured mesh"
32 ! mesh description
33 character(MED_COMMENT_SIZE) :: mdesc
34 ! mesh dimension, space dimension
35 integer mdim, sdim
36 ! mesh sorting type
37 integer stype
38 integer nstep
39 ! mesh type, axis type
40 integer mtype, atype
41 ! axis name, axis unit
42 character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
43 character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
44 character(MED_SNAME_SIZE) :: dtunit =""
45 ! coordinates
46 real*8, dimension(:), allocatable :: coords
47 integer nnodes
48 integer, dimension(:), allocatable :: tricon
49 integer ntria3
50 integer, dimension(:), allocatable :: quacon
51 integer nquad4
52
53 ! coordinate changement, geometry transformation
54 integer coocha, geotra
55
56 integer it
57
58 ! profil size
59 integer profsz
60 ! profil name
61 character(MED_NAME_SIZE) :: profna = ""
62
63 integer numdt, numit
64 real*8 dt
65
66 ! open MED file with READ ONLY access mode
67 call mfiope(fid, "UsesCase_MEDmesh_6.med", med_acc_rdonly, cret)
68 if (cret .ne. 0 ) then
69 print *, "ERROR : open file"
70 call efexit(-1)
71 endif
72
73 ! ... we know that the MED file has only one mesh,
74 ! a real code working would check ...
75
76 ! read mesh informations
77 allocate ( aname(2), aunit(2) ,stat=cret )
78 if (cret > 0) then
79 print *, "ERROR : memory allocation"
80 call efexit(-1)
81 endif
82
83 call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, aname, aunit, cret)
84 if (cret .ne. 0 ) then
85 print *, "ERROR : read mesh informations"
86 call efexit(-1)
87 endif
88 print *,"mesh name =", mname
89 print *,"space dim =", sdim
90 print *,"mesh dim =", mdim
91 print *,"mesh type =", mtype
92 print *,"mesh description =", mdesc
93 print *,"dt unit = ", dtunit
94 print *,"sorting type =", stype
95 print *,"number of computing step =", nstep
96 print *,"coordinates axis type =", atype
97 print *,"coordinates axis name =", aname
98 print *,"coordinates axis units =", aunit
99 deallocate(aname, aunit)
100
101 ! read how many nodes in the mesh **
102 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
103 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
104 if (cret .ne. 0 ) then
105 print *, "ERROR : read how many nodes in the mesh"
106 call efexit(-1)
107 endif
108 print *, "number of nodes in the mesh =", nnodes
109
110 ! we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh
111 ! a real code working would check all MED geometry cell types
112
113 ! read how many triangular cells in the mesh
114 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, med_connectivity, &
115 med_nodal, coocha, geotra, ntria3, cret)
116 if (cret .ne. 0 ) then
117 print *, "ERROR : read how many nodes in the mesh"
118 call efexit(-1)
119 endif
120 print *,"number of triangular cells in the mesh =", ntria3
121
122 ! read how many quadrangular cells in the mesh
123 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, med_connectivity, &
124 med_nodal, coocha, geotra, nquad4, cret)
125 if (cret .ne. 0 ) then
126 print *, "ERROR : read how many nodes in the mesh"
127 call efexit(-1)
128 endif
129 print *,"number of quadrangular cells in the mesh =", nquad4
130
131 ! read mesh nodes coordinates in the initial mesh
132 allocate (coords(nnodes*2),stat=cret)
133 if (cret > 0) then
134 print *,"ERROR : memory allocation"
135 call efexit(-1)
136 endif
137
138 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
139 if (cret .ne. 0 ) then
140 print *,"ERROR : nodes coordinates"
141 call efexit(-1)
142 endif
143 print *,"Nodes coordinates =", coords
144 deallocate(coords)
145
146 ! read cells connectivity in the mesh
147 allocate ( tricon(ntria3 * 3) ,stat=cret )
148 if (cret > 0) then
149 print *,"ERROR : memory allocation"
150 call efexit(-1)
151 endif
152
153 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, &
154 med_nodal,med_full_interlace,tricon,cret)
155 if (cret .ne. 0 ) then
156 print *,"ERROR : MED_TRIA3 connectivity"
157 call efexit(-1)
158 endif
159 print *,"MED_TRIA3 connectivity =", tricon
160 deallocate(tricon)
161
162 allocate ( quacon(nquad4*4) ,stat=cret )
163 if (cret > 0) then
164 print *,"ERROR : memory allocation"
165 call efexit(-1)
166 endif
167
168 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, &
169 med_nodal, med_full_interlace, quacon, cret)
170 if (cret .ne. 0 ) then
171 print *,"ERROR : MED_QUAD4 connectivity"
172 call efexit(-1)
173 endif
174 print *,"MED_QUAD4 connectivity =", quacon
175 deallocate(quacon)
176
177 ! we know that the family number of nodes and elements is 0, a real working would check ...
178
179 ! read nodes coordinates changements step by step
180 do it=1, nstep-1
181
182 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
183 if (cret .ne. 0 ) then
184 print *,"ERROR : computing step info"
185 call efexit(-1)
186 endif
187 print *,"numdt =", numdt
188 print *,"numit =", numit
189 print *,"dt =", dt
190
191 ! test for nodes coordinates change
192 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
193 med_coordinate, med_no_cmode, med_global_stmode, &
194 profna, profsz, coocha, geotra, nnodes, cret)
195 if (cret .ne. 0 ) then
196 print *,"ERROR : nodes coordinates"
197 call efexit(-1)
198 endif
199 print *, "profna = ", profna
200 print *, "coocha =", coocha
201
202 ! if coordinates have changed, then read the new coordinates
203 if (coocha == 1) then
204
205 allocate (coords(nnodes*2),stat=cret)
206 if (cret > 0) then
207 print *,"ERROR : memory allocation"
208 call efexit(-1)
209 endif
210
211 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
212 med_full_interlace,med_all_constituent, coords, cret)
213 if (cret .ne. 0 ) then
214 print *,"ERROR : nodes coordinates"
215 call efexit(-1)
216 endif
217 print *,"Nodes coordinates =", coords
218 deallocate(coords)
219
220 end if
221
222 end do
223
224 ! close file
225 call mficlo(fid,cret)
226 if (cret .ne. 0 ) then
227 print *,"ERROR : close file"
228 call efexit(-1)
229 endif
230
231end program usescase_medmesh_7
232
233
program usescase_medmesh_7
subroutine mfiope(fid, name, access, cret)
Definition medfile.f:42
subroutine mficlo(fid, cret)
Definition medfile.f:82
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition medmesh.f:320
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition medmesh.f:130
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Definition medmesh.f:1038
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition medmesh.f:551
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
Definition medmesh.f:670
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition medmesh.f:600
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition medmesh.f:362