MED fichier: Fichier source de UsesCase_MEDmesh_7.f90

MED fichier

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