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