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