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