MED fichier
UsesCase_MEDmesh_2.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 2 read a 2D unstructured mesh with 15 nodes,
20 !* 8 triangular cells, 4 triangular cells
21 !* - Computation step : NO
22 !*
23 
25 
26  implicit none
27  include 'med.hf90'
28 
29  integer cret
30  integer*8 fid
31  integer nmesh, it, naxis
32  character(64) :: mname = "2D unstructured mesh"
33  character(200) :: desc
34  character(16) :: dtunit
35  integer nstep, mdim, sdim, stype, mtype, atype
36  character(16), dimension(:), allocatable :: aname
37  character(16), dimension (:), allocatable :: aunit
38  real*8, dimension(:), allocatable :: ncoord
39  integer coocha, geotra, nnodes, ntria3, nquad4
40  integer, dimension(:), allocatable :: tricon
41  integer, dimension(:), allocatable :: quacon
42 
43  ! open MED file with READ ONLY access mode **
44  call mfiope(fid,'UsesCase_MEDmesh_1.med',med_acc_rdonly, cret)
45  if (cret .ne. 0 ) then
46  print *,'ERROR : open file'
47  call efexit(-1)
48  endif
49 
50  ! ... we know that the MED file has only one mesh,
51  ! a real code working would check ...
52 
53  ! read mesh informations : computation space dimension
54  call mmhnan(fid,mname,naxis,cret)
55  if (cret .ne. 0 ) then
56  print *,'Read number of axis in the mesh'
57  call efexit(-1)
58  endif
59  print *,'Number of axis in the mesh = ',naxis
60 
61  ! read mesh informations
62  allocate ( aname(naxis), aunit(naxis) ,stat=cret )
63  if (cret > 0) then
64  print *,'Memory allocation'
65  call efexit(-1)
66  endif
67 
68  call mmhmin(fid, mname, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
69  if (cret .ne. 0 ) then
70  print *,'Read mesh informations'
71  call efexit(-1)
72  endif
73  print *,"mesh name =", mname
74  print *,"space dim =", sdim
75  print *,"mesh dim =", mdim
76  print *,"mesh type =", mtype
77  print *,"mesh description =", desc
78  print *,"dt unit = ", dtunit
79  print *,"sorting type =", stype
80  print *,"number of computing step =", nstep
81  print *,"coordinates axis type =", atype
82  print *,"coordinates axis name =", aname
83  print *,"coordinates axis units =", aunit
84  deallocate(aname, aunit)
85 
86  ! read how many nodes in the mesh **
87  call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_no_geotype,med_coordinate,med_no_cmode,coocha,geotra,nnodes,cret)
88  if (cret .ne. 0 ) then
89  print *,'Read how many nodes in the mesh'
90  call efexit(-1)
91  endif
92  print *,"number of nodes in the mesh =", nnodes
93 
94  ! we know that we only have MED_TRIA3 and MED_QUAD4 in the mesh
95  ! a real code working would check all MED geometry cell types
96 
97  ! read how many triangular cells in the mesh
98  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_connectivity,med_nodal,coocha,geotra,ntria3,cret)
99  if (cret .ne. 0 ) then
100  print *,'Read how many nodes in the mesh'
101  call efexit(-1)
102  endif
103  print *,"number of triangular cells in the mesh =", ntria3
104 
105  ! read how many quadrangular cells in the mesh
106  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_connectivity,med_nodal,coocha,geotra,nquad4,cret)
107  if (cret .ne. 0 ) then
108  print *,'Read how many nodes in the mesh'
109  call efexit(-1)
110  endif
111  print *,"number of quadrangular cells in the mesh =", nquad4
112 
113  ! read mesh nodes coordinates
114  allocate (ncoord(nnodes*2),stat=cret)
115  if (cret > 0) then
116  print *,'Memory allocation'
117  call efexit(-1)
118  endif
119 
120  call mmhcor(fid,mname,med_no_dt,med_no_it,med_full_interlace,ncoord,cret)
121  if (cret .ne. 0 ) then
122  print *,'Nodes coordinates'
123  call efexit(-1)
124  endif
125  print *,"Nodes coordinates =", ncoord
126  deallocate(ncoord)
127 
128  ! read cells connectivity in the mesh
129  allocate ( tricon(ntria3 * 3) ,stat=cret )
130  if (cret > 0) then
131  print *,'Memory allocation'
132  call efexit(-1)
133  endif
134 
135  call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_tria3,med_nodal,med_full_interlace,tricon,cret)
136  if (cret .ne. 0 ) then
137  print *,'MED_TRIA3 connectivity'
138  call efexit(-1)
139  endif
140  print *,"MED_TRIA3 connectivity =", tricon
141  deallocate(tricon)
142 
143  allocate ( quacon(nquad4*4) ,stat=cret )
144  if (cret > 0) then
145  print *,'Memory allocation'
146  call efexit(-1)
147  endif
148 
149  call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,med_quad4,med_nodal,med_full_interlace,quacon,cret)
150  if (cret .ne. 0 ) then
151  print *,'MED_QUAD4 connectivity'
152  call efexit(-1)
153  endif
154  print *,"MED_QUAD4 connectivity =", quacon
155  deallocate(quacon)
156 
157  ! we know that the family number of nodes and elements is 0, a real working would check ...
158 
159  ! close file **
160  call mficlo(fid,cret)
161  if (cret .ne. 0 ) then
162  print *,'ERROR : close file'
163  call efexit(-1)
164  endif
165 
166 end program usescase_medmesh_2
167 
subroutine mfiope(fid, name, access, cret)
Definition: medfile.f:42
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:130
subroutine mficlo(fid, cret)
Definition: medfile.f:82
program usescase_medmesh_2
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
subroutine mmhnan(fid, name, naxis, cret)
Definition: medmesh.f:86
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551