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