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 mficlo(fid, cret)
Definition: medfile.f:80
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Definition: medmesh.f:1038
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
Definition: medmesh.f:1270
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
Definition: medmesh.f:670
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:41
program usescase_medmesh_12
subroutine mmhnmh(fid, n, cret)
Definition: medmesh.f:41
subroutine mmhnax(fid, it, naxis, cret)
Definition: medmesh.f:64
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition: medmesh.f:362