MED fichier: Fichier source de UsesCase_MEDmesh_7.f90

MED fichier

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

UsesCase_MEDmesh_7.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 7 : read a 2D unstructured mesh with nodes coordinates modifications
20 !*
21
22 program usescase_medmesh_7
23
24 implicit none
25 include 'med.hf90'
26
27 integer cret
28 integer fid
29 ! mesh name
30 character(MED_NAME_SIZE) :: mname = "2D unstructured mesh"
31 ! mesh description
32 character(MED_COMMENT_SIZE) :: mdesc
33 ! mesh dimension, space dimension
34 integer mdim, sdim
35 ! mesh sorting type
36 integer stype
37 integer nstep
38 ! mesh type, axis type
39 integer mtype, atype
40 ! axis name, axis unit
41 character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
42 character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
43 character(MED_SNAME_SIZE) :: dtunit =""
44 ! coordinates
45 real*8, dimension(:), allocatable :: coords
46 integer nnodes
47 integer, dimension(:), allocatable :: tricon
48 integer ntria3
49 integer, dimension(:), allocatable :: quacon
50 integer nquad4
51
52 ! coordinate changement, geometry transformation
53 integer coocha, geotra
54
55 integer it
56
57 ! profil size
58 integer profsz
59 ! profil name
60 character(MED_NAME_SIZE) :: profna = ""
61
62 integer numdt, numit
63 real*8 dt
64
65 ! open MED file with READ ONLY access mode
66 call mfiope(fid, "UsesCase_MEDmesh_6.med", med_acc_rdonly, cret)
67 if (cret .ne. 0 ) then
68 print *, "ERROR : open file"
69 call efexit(-1)
70 endif
71
72 ! ... we know that the MED file has only one mesh,
73 ! a real code working would check ...
74
75 ! read mesh informations
76 allocate ( aname(2), aunit(2) ,stat=cret )
77 if (cret > 0) then
78 print *, "ERROR : memory allocation"
79 call efexit(-1)
80 endif
81
82 call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, aname, aunit, cret)
83 if (cret .ne. 0 ) then
84 print *, "ERROR : read mesh informations"
85 call efexit(-1)
86 endif
87 print *,"mesh name =", mname
88 print *,"space dim =", sdim
89 print *,"mesh dim =", mdim
90 print *,"mesh type =", mtype
91 print *,"mesh description =", mdesc
92 print *,"dt unit = ", dtunit
93 print *,"sorting type =", stype
94 print *,"number of computing step =", nstep
95 print *,"coordinates axis type =", atype
96 print *,"coordinates axis name =", aname
97 print *,"coordinates axis units =", aunit
98 deallocate(aname, aunit)
99
100 ! read how many nodes in the mesh **
101 call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
102 med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
103 if (cret .ne. 0 ) then
104 print *, "ERROR : read how many nodes in the mesh"
105 call efexit(-1)
106 endif
107 print *, "number of nodes in the mesh =", nnodes
108
109 ! we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh
110 ! a real code working would check all MED geometry cell types
111
112 ! read how many triangular cells in the mesh
113 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, med_connectivity, &
114 med_nodal, coocha, geotra, ntria3, cret)
115 if (cret .ne. 0 ) then
116 print *, "ERROR : read how many nodes in the mesh"
117 call efexit(-1)
118 endif
119 print *,"number of triangular cells in the mesh =", ntria3
120
121 ! read how many quadrangular cells in the mesh
122 call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, med_connectivity, &
123 med_nodal, coocha, geotra, nquad4, cret)
124 if (cret .ne. 0 ) then
125 print *, "ERROR : read how many nodes in the mesh"
126 call efexit(-1)
127 endif
128 print *,"number of quadrangular cells in the mesh =", nquad4
129
130 ! read mesh nodes coordinates in the initial mesh
131 allocate (coords(nnodes*2),stat=cret)
132 if (cret > 0) then
133 print *,"ERROR : memory allocation"
134 call efexit(-1)
135 endif
136
137 call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
138 if (cret .ne. 0 ) then
139 print *,"ERROR : nodes coordinates"
140 call efexit(-1)
141 endif
142 print *,"Nodes coordinates =", coords
143 deallocate(coords)
144
145 ! read cells connectivity in the mesh
146 allocate ( tricon(ntria3 * 3) ,stat=cret )
147 if (cret > 0) then
148 print *,"ERROR : memory allocation"
149 call efexit(-1)
150 endif
151
152 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, &
153 med_nodal,med_full_interlace,tricon,cret)
154 if (cret .ne. 0 ) then
155 print *,"ERROR : MED_TRIA3 connectivity"
156 call efexit(-1)
157 endif
158 print *,"MED_TRIA3 connectivity =", tricon
159 deallocate(tricon)
160
161 allocate ( quacon(nquad4*4) ,stat=cret )
162 if (cret > 0) then
163 print *,"ERROR : memory allocation"
164 call efexit(-1)
165 endif
166
167 call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, &
168 med_nodal, med_full_interlace, quacon, cret)
169 if (cret .ne. 0 ) then
170 print *,"ERROR : MED_QUAD4 connectivity"
171 call efexit(-1)
172 endif
173 print *,"MED_QUAD4 connectivity =", quacon
174 deallocate(quacon)
175
176 ! we know that the family number of nodes and elements is 0, a real working would check ...
177
178 ! read nodes coordinates changements step by step
179 do it=1, nstep-1
180
181 call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
182 if (cret .ne. 0 ) then
183 print *,"ERROR : computing step info"
184 call efexit(-1)
185 endif
186 print *,"numdt =", numdt
187 print *,"numit =", numit
188 print *,"dt =", dt
189
190 ! test for nodes coordinates change
191 call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
192 med_coordinate, med_no_cmode, med_global_stmode, &
193 profna, profsz, coocha, geotra, nnodes, cret)
194 if (cret .ne. 0 ) then
195 print *,"ERROR : nodes coordinates"
196 call efexit(-1)
197 endif
198 print *, "profna = ", profna
199 print *, "coocha =", coocha
200
201 ! if coordinates have changed, then read the new coordinates
202 if (coocha == 1) then
203
204 allocate (coords(nnodes*2),stat=cret)
205 if (cret > 0) then
206 print *,"ERROR : memory allocation"
207 call efexit(-1)
208 endif
209
210 call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
211 med_full_interlace,med_all_constituent, coords, cret)
212 if (cret .ne. 0 ) then
213 print *,"ERROR : nodes coordinates"
214 call efexit(-1)
215 endif
216 print *,"Nodes coordinates =", coords
217 deallocate(coords)
218
219 end if
220
221 end do
222
223 ! close file
224 call mficlo(fid,cret)
225 if (cret .ne. 0 ) then
226 print *,"ERROR : close file"
227 call efexit(-1)
228 endif
229
230 end program usescase_medmesh_7
231
232
mmhmin
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage en précisant son nom...
Definition: medmesh.f:125
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
usescase_medmesh_7
program usescase_medmesh_7
Definition: UsesCase_MEDmesh_7.f90:22
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
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41