MED fichier: Fichier source de UsesCase_MEDmesh_12.f90

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

UsesCase_MEDmesh_12.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 !*
19 !* Use case 12 : read a 2D unstructured mesh with moving grid (generic approach)
20 !*
21 !*
22
23 program usescase_medmesh_12
24
25 implicit none
26 include 'med.hf90'
27
28 integer cret
29 integer*8 fid
30
31 ! mesh number
32 integer nmesh
33 ! mesh name
34 character(MED_NAME_SIZE) :: mname = ""
35 ! mesh description
36 character(MED_COMMENT_SIZE) :: mdesc = ""
37 ! mesh dimension, space dimension
38 integer mdim, sdim
39 ! mesh sorting type
40 integer stype
41 integer nstep
42 ! mesh type, axis type
43 integer mtype, atype
44 ! axis name, axis unit
45 character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
46 character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
47 character(MED_SNAME_SIZE) :: dtunit = ""
48 ! coordinates
49 real*8, dimension(:), allocatable :: coords
50 integer ngeo
51 integer nnodes
52 ! connectivity
53 integer , dimension(:), allocatable :: conity
54
55 ! coordinate changement, geometry transformation, matrix transformation
56 integer coocha, geotra, matran
57
58 ! matrix size
59 integer matsiz
60
61 real*8 :: matrix(7) = 0.0
62
63 integer i, it, j
64
65 ! profil size
66 integer profsz
67 ! profil name
68 character(MED_NAME_SIZE) :: profna = ""
69
70 integer numdt, numit
71 real*8 dt
72
73 ! geometry type
74 integer geotyp
75 integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
76
77 geotps = med_get_cell_geometry_type
78
79 ! open MED file with READ ONLY access mode
80 call mfiope(fid, "UsesCase_MEDmesh_9.med", med_acc_rdonly, cret)
81 if (cret .ne. 0 ) then
82 print *, "ERROR : open file"
83 call efexit(-1)
84 endif
85
86 ! read how many mesh in the file
87 call mmhnmh(fid, nmesh, cret)
88 if (cret .ne. 0 ) then
89 print *, "ERROR : read how many mesh"
90 call efexit(-1)
91 endif
92
93 print *, "nmesh :", nmesh
94
95 do i=1, nmesh
96
97 ! read computation space dimension
98 call mmhnax(fid, i, sdim, cret)
99 if (cret .ne. 0 ) then
100 print *, "ERROR : read computation space dimension"
101 call efexit(-1)
102 endif
103
104 ! memory allocation
105 allocate ( aname(sdim), aunit(sdim) ,stat=cret )
106 if (cret > 0) then
107 print *, "ERROR : memory allocation"
108 call efexit(-1)
109 endif
110
111 ! read mesh informations
112 call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
113 atype, aname, aunit, cret)
114 if (cret .ne. 0 ) then
115 print *, "ERROR : read mesh informations"
116 call efexit(-1)
117 endif
118 print *,"mesh name =", mname
119 print *,"space dim =", sdim
120 print *,"mesh dim =", mdim
121 print *,"mesh type =", mtype
122 print *,"mesh description =", mdesc
123 print *,"dt unit = ", dtunit
124 print *,"sorting type =", stype
125 print *,"number of computing step =", nstep
126 print *,"coordinates axis type =", atype
127 print *,"coordinates axis name =", aname
128 print *,"coordinates axis units =", aunit
129 deallocate(aname, aunit)
130
131 ! read how many nodes in the mesh **
132 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
133 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
134 if (cret .ne. 0 ) then
135 print *, "ERROR : read how many nodes in the mesh"
136 call efexit(-1)
137 endif
138 print *, "number of nodes in the mesh =", nnodes
139
140 ! read mesh nodes coordinates
141 allocate (coords(nnodes*sdim),stat=cret)
142 if (cret > 0) then
143 print *,"ERROR : memory allocation"
144 call efexit(-1)
145 endif
146
147 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
148 if (cret .ne. 0 ) then
149 print *,"ERROR : nodes coordinates"
150 call efexit(-1)
151 endif
152 print *,"Nodes coordinates =", coords
153 deallocate(coords)
154
155 ! read all MED geometry cell types
156 do it=1, med_n_cell_fixed_geo
157
158 geotyp = geotps(it)
159
160 print *, "geotps(it) :", geotps(it)
161
162 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, geotyp, &
163 med_connectivity, med_nodal, coocha, &
164 geotra, ngeo, cret)
165 if (cret .ne. 0 ) then
166 print *,"ERROR : number of cells"
167 call efexit(-1)
168 endif
169 print *,"Number of cells =", ngeo
170
171 ! print *, "mod(ngeo, 100) : ", mod(geotyp,100)
172
173 if (ngeo .ne. 0) then
174 allocate (conity(ngeo*mod(geotyp,100)), stat=cret)
175 if (cret > 0) then
176 print *,"ERROR : memory allocation"
177 call efexit(-1)
178 endif
179
180 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, &
181 geotyp, med_nodal, med_full_interlace, &
182 conity, cret)
183 if (cret > 0) then
184 print *,"ERROR : cellconnectivity", conity
185 call efexit(-1)
186 endif
187 deallocate(conity)
188
189 endif !ngeo .ne. 0
190 end do ! read all MED geometry cell types
191
192 ! read nodes coordinates changements step by step
193 do it=1, nstep-1
194
195 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
196 if (cret .ne. 0 ) then
197 print *,"ERROR : computing step info"
198 call efexit(-1)
199 endif
200 print *,"numdt =", numdt
201 print *,"numit =", numit
202 print *,"dt =", dt
203
204 ! test for nodes coordinates change
205 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
206 med_coordinate, med_no_cmode, med_global_stmode, &
207 profna, profsz, coocha, geotra, nnodes, cret)
208 if (cret .ne. 0 ) then
209 print *,"ERROR : nodes coordinates"
210 call efexit(-1)
211 endif
212 print *, "profna =", profna
213 print *, "coocha =", coocha
214 print *, "geotra =", geotra
215
216 ! if only coordinates have changed, then read the new coordinates
217 ! to verify if there is a matrix transformation => UsesCase_MEDmesh12
218 if (coocha == 1 .and. geotra == 1) then
219
220 allocate (coords(nnodes*2),stat=cret)
221 if (cret > 0) then
222 print *,"ERROR : memory allocation"
223 call efexit(-1)
224 endif
225
226 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
227 med_full_interlace,med_all_constituent, coords, cret)
228 if (cret .ne. 0 ) then
229 print *,"ERROR : nodes coordinates"
230 call efexit(-1)
231 endif
232 print *,"Nodes coordinates =", coords
233 deallocate(coords)
234
235 end if
236
237 if (coocha == 1 .and. .not. geotra == 1) then
238
239 call mmhnme(fid,mname,numdt,numit, &
240 med_node,med_none,med_coordinate_trsf,med_nodal,coocha, &
241 matran, matsiz, cret)
242 if (cret .ne. 0 ) then
243 print *,"ERROR : transformation matrix"
244 call efexit(-1)
245 endif
246 print *,"Transformation matrix flag =", matran
247 print *,"Matrix size = ", matsiz
248
249 if (matran == 1) then
250 call mmhtfr(fid, mname, numdt, numit, matrix, cret)
251 if (cret .ne. 0 ) then
252 print *,"ERROR : transformation matrix"
253 call efexit(-1)
254 endif
255 print *,"Transformation matrix =", matrix
256
257 end if
258 end if
259 end do ! it=1, nstep-1
260 end do ! i=0, nmesh-1
261
262 ! close file
263 call mficlo(fid,cret)
264 if (cret .ne. 0 ) then
265 print *,"ERROR : close file"
266 call efexit(-1)
267 endif
268
269 end program usescase_medmesh_12
270
271
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
mmhnmh
subroutine mmhnmh(fid, n, cret)
Definition: medmesh.f:41
mmhcpr
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition: medmesh.f:362
mmhnax
subroutine mmhnax(fid, it, naxis, cret)
Definition: medmesh.f:64
mmhtfr
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
Definition: medmesh.f:1270
mmhcsi
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Definition: medmesh.f:1038
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
mmhmii
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
mfiope
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
mmhnep
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
Definition: medmesh.f:670
usescase_medmesh_12
program usescase_medmesh_12
Definition: UsesCase_MEDmesh_12.f90:23
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82