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 mficlo(fid, cret)
Definition: medfile.f:80
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
program usescase_medmesh_8
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 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
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