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