MED fichier
UsesCase_MEDmesh_12.f90
Aller à la documentation de ce fichier.
1 !* This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2019 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 
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition: medmesh.f:362
program usescase_medmesh_12
subroutine mmhnmh(fid, n, cret)
Definition: medmesh.f:41
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
subroutine mmhnax(fid, it, naxis, cret)
Definition: medmesh.f:64
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
subroutine mmhtfr(fid, name, numdt, numit, tsf, cret)
Definition: medmesh.f:1270
subroutine mmhcsi(fid, name, csit, numdt, numit, dt, cret)
Definition: medmesh.f:1038
subroutine mmhnep(fid, name, numdt, numit, entype, geotype, datype, cmode, stmode, pname, psize, chgt, tsf, n, cret)
Definition: medmesh.f:670
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
subroutine mficlo(fid, cret)
Definition: medfile.f:82