MED fichier
UsesCase_MEDmesh_7.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2016 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 
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 
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
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
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
program usescase_medmesh_7
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
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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
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
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
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