MED fichier
UsesCase_MEDmesh_8.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 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 
subroutine mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition: medmesh.f:362
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
program usescase_medmesh_8
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