MED fichier
UsesCase_MEDmesh_7.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 7 : read a 2D unstructured mesh with nodes coordinates modifications
20 !*
21 
23 
24  implicit none
25  include 'med.hf90'
26 
27  integer cret
28  integer fid
29  ! mesh name
30  character(MED_NAME_SIZE) :: mname = "2D unstructured mesh"
31  ! mesh description
32  character(MED_COMMENT_SIZE) :: mdesc
33  ! mesh dimension, space dimension
34  integer mdim, sdim
35  ! mesh sorting type
36  integer stype
37  integer nstep
38  ! mesh type, axis type
39  integer mtype, atype
40  ! axis name, axis unit
41  character(MED_SNAME_SIZE), dimension(:), allocatable :: aname
42  character(MED_SNAME_SIZE), dimension(:), allocatable :: aunit
43  character(MED_SNAME_SIZE) :: dtunit =""
44  ! coordinates
45  real*8, dimension(:), allocatable :: coords
46  integer nnodes
47  integer, dimension(:), allocatable :: tricon
48  integer ntria3
49  integer, dimension(:), allocatable :: quacon
50  integer nquad4
51 
52  ! coordinate changement, geometry transformation
53  integer coocha, geotra
54 
55  integer it
56 
57  ! profil size
58  integer profsz
59  ! profil name
60  character(MED_NAME_SIZE) :: profna = ""
61 
62  integer numdt, numit
63  real*8 dt
64 
65  ! open MED file with READ ONLY access mode
66  call mfiope(fid, "UsesCase_MEDmesh_6.med", med_acc_rdonly, cret)
67  if (cret .ne. 0 ) then
68  print *, "ERROR : open file"
69  call efexit(-1)
70  endif
71 
72  ! ... we know that the MED file has only one mesh,
73  ! a real code working would check ...
74 
75  ! read mesh informations
76  allocate ( aname(2), aunit(2) ,stat=cret )
77  if (cret > 0) then
78  print *, "ERROR : memory allocation"
79  call efexit(-1)
80  endif
81 
82  call mmhmin(fid, mname, sdim, mdim, mtype, mdesc, dtunit, stype, nstep, atype, aname, aunit, cret)
83  if (cret .ne. 0 ) then
84  print *, "ERROR : read mesh informations"
85  call efexit(-1)
86  endif
87  print *,"mesh name =", mname
88  print *,"space dim =", sdim
89  print *,"mesh dim =", mdim
90  print *,"mesh type =", mtype
91  print *,"mesh description =", mdesc
92  print *,"dt unit = ", dtunit
93  print *,"sorting type =", stype
94  print *,"number of computing step =", nstep
95  print *,"coordinates axis type =", atype
96  print *,"coordinates axis name =", aname
97  print *,"coordinates axis units =", aunit
98  deallocate(aname, aunit)
99 
100  ! read how many nodes in the mesh **
101  call mmhnme(fid, mname, med_no_dt, med_no_it, med_node, med_no_geotype, &
102  med_coordinate, med_no_cmode, coocha, geotra, nnodes, cret)
103  if (cret .ne. 0 ) then
104  print *, "ERROR : read how many nodes in the mesh"
105  call efexit(-1)
106  endif
107  print *, "number of nodes in the mesh =", nnodes
108 
109  ! we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh
110  ! a real code working would check all MED geometry cell types
111 
112  ! read how many triangular cells in the mesh
113  call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, med_connectivity, &
114  med_nodal, coocha, geotra, ntria3, cret)
115  if (cret .ne. 0 ) then
116  print *, "ERROR : read how many nodes in the mesh"
117  call efexit(-1)
118  endif
119  print *,"number of triangular cells in the mesh =", ntria3
120 
121  ! read how many quadrangular cells in the mesh
122  call mmhnme(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, med_connectivity, &
123  med_nodal, coocha, geotra, nquad4, cret)
124  if (cret .ne. 0 ) then
125  print *, "ERROR : read how many nodes in the mesh"
126  call efexit(-1)
127  endif
128  print *,"number of quadrangular cells in the mesh =", nquad4
129 
130  ! read mesh nodes coordinates in the initial mesh
131  allocate (coords(nnodes*2),stat=cret)
132  if (cret > 0) then
133  print *,"ERROR : memory allocation"
134  call efexit(-1)
135  endif
136 
137  call mmhcor(fid, mname, med_no_dt, med_no_it, med_full_interlace, coords, cret)
138  if (cret .ne. 0 ) then
139  print *,"ERROR : nodes coordinates"
140  call efexit(-1)
141  endif
142  print *,"Nodes coordinates =", coords
143  deallocate(coords)
144 
145  ! read cells connectivity in the mesh
146  allocate ( tricon(ntria3 * 3) ,stat=cret )
147  if (cret > 0) then
148  print *,"ERROR : memory allocation"
149  call efexit(-1)
150  endif
151 
152  call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_tria3, &
153  med_nodal,med_full_interlace,tricon,cret)
154  if (cret .ne. 0 ) then
155  print *,"ERROR : MED_TRIA3 connectivity"
156  call efexit(-1)
157  endif
158  print *,"MED_TRIA3 connectivity =", tricon
159  deallocate(tricon)
160 
161  allocate ( quacon(nquad4*4) ,stat=cret )
162  if (cret > 0) then
163  print *,"ERROR : memory allocation"
164  call efexit(-1)
165  endif
166 
167  call mmhcyr(fid, mname, med_no_dt, med_no_it, med_cell, med_quad4, &
168  med_nodal, med_full_interlace, quacon, cret)
169  if (cret .ne. 0 ) then
170  print *,"ERROR : MED_QUAD4 connectivity"
171  call efexit(-1)
172  endif
173  print *,"MED_QUAD4 connectivity =", quacon
174  deallocate(quacon)
175 
176  ! we know that the family number of nodes and elements is 0, a real working would check ...
177 
178  ! read nodes coordinates changements step by step
179  do it=1, nstep-1
180 
181  call mmhcsi(fid, mname, it+1, numdt, numit, dt, cret)
182  if (cret .ne. 0 ) then
183  print *,"ERROR : computing step info"
184  call efexit(-1)
185  endif
186  print *,"numdt =", numdt
187  print *,"numit =", numit
188  print *,"dt =", dt
189 
190  ! test for nodes coordinates change
191  call mmhnep(fid, mname, numdt, numit, med_node, med_no_geotype, &
192  med_coordinate, med_no_cmode, med_global_stmode, &
193  profna, profsz, coocha, geotra, nnodes, cret)
194  if (cret .ne. 0 ) then
195  print *,"ERROR : nodes coordinates"
196  call efexit(-1)
197  endif
198  print *, "profna = ", profna
199  print *, "coocha =", coocha
200 
201  ! if coordinates have changed, then read the new coordinates
202  if (coocha == 1) then
203 
204  allocate (coords(nnodes*2),stat=cret)
205  if (cret > 0) then
206  print *,"ERROR : memory allocation"
207  call efexit(-1)
208  endif
209 
210  call mmhcpr(fid, mname, numdt, numit,med_global_stmode,profna, &
211  med_full_interlace,med_all_constituent, coords, cret)
212  if (cret .ne. 0 ) then
213  print *,"ERROR : nodes coordinates"
214  call efexit(-1)
215  endif
216  print *,"Nodes coordinates =", coords
217  deallocate(coords)
218 
219  end if
220 
221  end do
222 
223  ! close file
224  call mficlo(fid,cret)
225  if (cret .ne. 0 ) then
226  print *,"ERROR : close file"
227  call efexit(-1)
228  endif
229 
230 end program usescase_medmesh_7
231 
232 
subroutine mficlo(fid, cret)
Definition: medfile.f:80
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:130
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 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 mmhcpr(fid, name, numdt, numit, stm, pname, swm, dim, coo, cret)
Definition: medmesh.f:362
program usescase_medmesh_7