MED fichier: Fichier source de UsesCase_MEDmesh_8.f90

MED fichier

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

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