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