MED fichier: Fichier source de UsesCase_MEDmesh_8.f90

MED fichier

UsesCase_MEDmesh_8.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 8 : read a 2D unstructured mesh with nodes coordinates modifications
20 !* (generic approach)
21 !*
22
23 program usescase_medmesh_8
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
56 integer coocha, geotra
57
58 integer i, it, j
59
60 ! profil size
61 integer profsz
62 ! profil name
63 character(MED_NAME_SIZE) :: profna = ""
64
65 integer numdt, numit
66 real*8 dt
67
68 ! geometry type
69 integer geotyp
70 integer, dimension(MED_N_CELL_FIXED_GEO) :: geotps
71
72 ! print *, "MED_N_CELL_FIXED_GEO :", MED_N_CELL_FIXED_GEO
73 ! print *, "MED_GET_CELL_GEOMETRY_TYPE :", MED_GET_CELL_GEOMETRY_TYPE
74
75 geotps = med_get_cell_geometry_type
76 ! do it=1, MED_N_CELL_FIXED_GEO
77 ! print *, it, " : ", MED_GET_CELL_GEOMETRY_TYPE(it)
78 ! geotps(it) = MED_GET_CELL_GEOMETRY_TYPE(it)
79 ! print *, "geotps(",it,") =",geotps(it)
80 !end do
81
82 ! open MED file with READ ONLY access mode
83 call mfiope(fid, "UsesCase_MEDmesh_6.med", med_acc_rdonly, cret)
84 if (cret .ne. 0 ) then
85 print *, "ERROR : open file"
86 call efexit(-1)
87 endif
88
89 ! read how many mesh in the file
90 call mmhnmh(fid, nmesh, cret)
91 if (cret .ne. 0 ) then
92 print *, "ERROR : read how many mesh"
93 call efexit(-1)
94 endif
95
96 print *, "nmesh :", nmesh
97
98 do i=1, nmesh
99
100 ! read computation space dimension
101 call mmhnax(fid, i, sdim, cret)
102 if (cret .ne. 0 ) then
103 print *, "ERROR : read computation space dimension"
104 call efexit(-1)
105 endif
106
107 ! memory allocation
108 allocate ( aname(sdim), aunit(sdim) ,stat=cret )
109 if (cret > 0) then
110 print *, "ERROR : memory allocation"
111 call efexit(-1)
112 endif
113
114 ! read mesh informations
115 call mmhmii(fid, i, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, &
116 atype, aname, aunit, cret)
117 if (cret .ne. 0 ) then
118 print *, "ERROR : read mesh informations"
119 call efexit(-1)
120 endif
121 print *,"mesh name =", mname
122 print *,"space dim =", sdim
123 print *,"mesh dim =", mdim
124 print *,"mesh type =", mtype
125 print *,"mesh description =", mdesc
126 print *,"dt unit = ", dtunit
127 print *,"sorting type =", stype
128 print *,"number of computing step =", nstep
129 print *,"coordinates axis type =", atype
130 print *,"coordinates axis name =", aname
131 print *,"coordinates axis units =", aunit
132 deallocate(aname, aunit)
133
134 ! read how many nodes in the mesh **
135 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
136 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
137 if (cret .ne. 0 ) then
138 print *, "ERROR : read how many nodes in the mesh"
139 call efexit(-1)
140 endif
141 print *, "number of nodes in the mesh =", nnodes
142
143 ! read mesh nodes coordinates
144 allocate (coords(nnodes*sdim),stat=cret)
145 if (cret > 0) then
146 print *,"ERROR : memory allocation"
147 call efexit(-1)
148 endif
149
150 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
151 if (cret .ne. 0 ) then
152 print *,"ERROR : nodes coordinates"
153 call efexit(-1)
154 endif
155 print *,"Nodes coordinates =", coords
156 deallocate(coords)
157
158 ! read all MED geometry cell types
159 do it=1, med_n_cell_fixed_geo
160
161 geotyp = geotps(it)
162
163 print *, "geotps(it) :", geotps(it)
164
165 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, geotyp, &
166 med_connectivity, med_nodal, coocha, &
167 geotra, ngeo, cret)
168 if (cret .ne. 0 ) then
169 print *,"ERROR : number of cells"
170 call efexit(-1)
171 endif
172 print *,"Number of cells =", ngeo
173
174 ! print *, "mod(ngeo, 100) : ", mod(geotyp,100)
175
176 if (ngeo .ne. 0) then
177 allocate (conity(ngeo*mod(geotyp,100)), stat=cret)
178 if (cret > 0) then
179 print *,"ERROR : memory allocation"
180 call efexit(-1)
181 endif
182
183 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, &
184 geotyp, med_nodal, med_full_interlace, &
185 conity, cret)
186 if (cret > 0) then
187 print *,"ERROR : cellconnectivity", conity
188 call efexit(-1)
189 endif
190 deallocate(conity)
191
192 endif !ngeo .ne. 0
193 end do ! read all MED geometry cell types
194
195 ! read nodes coordinates changements step by step
196 do it=1, nstep-1
197
198 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
199 if (cret .ne. 0 ) then
200 print *,"ERROR : computing step info"
201 call efexit(-1)
202 endif
203 print *,"numdt =", numdt
204 print *,"numit =", numit
205 print *,"dt =", dt
206
207 ! test for nodes coordinates change
208 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
209 med_coordinate, med_no_cmode, med_global_stmode, &
210 profna, profsz, coocha, geotra, nnodes, cret)
211 if (cret .ne. 0 ) then
212 print *,"ERROR : nodes coordinates"
213 call efexit(-1)
214 endif
215 print *, "profna =", profna
216 print *, "coocha =", coocha
217 print *, "geotra =", geotra
218
219 ! if only coordinates have changed, then read the new coordinates
220 ! to verify if there is a matrix transformation => UsesCase_MEDmesh12
221 if (coocha == 1 .and. geotra == 1) then
222
223 allocate (coords(nnodes*2),stat=cret)
224 if (cret > 0) then
225 print *,"ERROR : memory allocation"
226 call efexit(-1)
227 endif
228
229 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
230 med_full_interlace,med_all_constituent, coords, cret)
231 if (cret .ne. 0 ) then
232 print *,"ERROR : nodes coordinates"
233 call efexit(-1)
234 endif
235 print *,"Nodes coordinates =", coords
236 deallocate(coords)
237
238 end if ! coocha == 1
239
240 end do ! it=1, nstep-1
241
242 end do ! i=0, nmesh-1
243
244 ! close file
245 call mficlo(fid,cret)
246 if (cret .ne. 0 ) then
247 print *,"ERROR : close file"
248 call efexit(-1)
249 endif
250
251 end program usescase_medmesh_8
252
253
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
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
usescase_medmesh_8
program usescase_medmesh_8
Definition: UsesCase_MEDmesh_8.f90:23
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