MED fichier: Fichier source de UsesCase_MEDmesh_12.f90

MED fichier

UsesCase_MEDmesh_12.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2023 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
mmhtfr
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
Cette routine lit les paramètres de translation rotation à appliquer aux noeuds de l'étape de calcul ...
Definition: medmesh.f:1270
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:110
usescase_medmesh_12
program usescase_medmesh_12
Definition: UsesCase_MEDmesh_12.f90:23
mmhcsi
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Cette routine permet de lire les informations relatives à une étape de calcul d'un maillage.
Definition: medmesh.f:1038
mmhnmh
subroutine mmhnmh(fid, n, cret)
Cette routine permet de lire le nombre de maillages dans un fichier.
Definition: medmesh.f:41
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,...
Definition: medmesh.f:362
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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 étape de calcul donnée.
Definition: medmesh.f:551
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:600
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:64
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 étape de calcul et un prof...
Definition: medmesh.f:670
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,...
Definition: medmesh.f:320
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42