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 
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