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