MED fichier
UsesCase_MEDmesh_3.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 3 : read an unstructured mesh : generic approach
20 !* - Computation step : NO
21 !*
22 
24 
25  implicit none
26  include 'med.hf90'
27 
28  integer cret
29  integer fid, nmesh, imesh, naxis, igeo, geotyp, nelt
30  character(64) :: mname, gtname
31  character(200) :: desc
32  character(16) :: dtunit
33  integer nstep, mdim, sdim, stype, mtype, atype
34  integer coocha, geotra, nnodes, ngeo
35  character(16), dimension(:), allocatable :: aname
36  character(16), dimension (:), allocatable :: aunit
37  real*8, dimension(:), allocatable :: ncoord
38 
39  integer, dimension(:), allocatable :: connectivity
40 
41  ! open file **
42  call mfiope(fid,'UsesCase_MEDmesh_1.med',med_acc_rdonly, cret)
43  if (cret .ne. 0 ) then
44  print *,'ERROR : open file'
45  call efexit(-1)
46  endif
47 
48  ! how many mesh in the file ? **
49  call mmhnmh(fid,nmesh,cret)
50  if (cret .ne. 0 ) then
51  print *,'Read how many mesh'
52  call efexit(-1)
53  endif
54  print *,'Number of mesh = ',nmesh
55 
56  do imesh=1,nmesh
57 
58  print *,'mesh iterator =',imesh
59 
60  ! read computation space dimension **
61  call mmhnax(fid,imesh,naxis,cret)
62  if (cret .ne. 0 ) then
63  print *,'Read number of axis in the mesh'
64  call efexit(-1)
65  endif
66  print *,'Number of axis in the mesh = ',naxis
67 
68  allocate ( aname(naxis), aunit(naxis) ,stat=cret )
69  if (cret > 0) then
70  print *,'Memory allocation'
71  call efexit(-1)
72  endif
73  ! read mesh informations **
74  call mmhmii(fid, imesh, mname, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
75  if (cret .ne. 0 ) then
76  print *,'Read mesh informations'
77  call efexit(-1)
78  endif
79  print *,"mesh name =", mname
80  print *,"space dim =", sdim
81  print *,"mesh dim =", mdim
82  print *,"mesh type =", mtype
83  print *,"mesh description =", desc
84  print *,"dt unit = ", dtunit
85  print *,"sorting type =", stype
86  print *,"number of computing step =", nstep
87  print *,"coordinates axis type =", atype
88  print *,"coordinates axis name =", aname
89  print *,"coordinates axis units =", aunit
90  deallocate(aname, aunit)
91 
92  ! read how many nodes in the mesh
93  call mmhnme(fid,mname,med_no_dt,med_no_it,med_node,med_no_geotype,med_coordinate,med_no_cmode,coocha,geotra,nnodes,cret)
94  if (cret .ne. 0 ) then
95  print *,'Read how many nodes in the mesh'
96  call efexit(-1)
97  endif
98  print *,"number of nodes in the mesh =", nnodes
99 
100  ! read mesh nodes coordinates
101  allocate ( ncoord(nnodes*2) ,stat=cret )
102  if (cret > 0) then
103  print *,'Memory allocation'
104  call efexit(-1)
105  endif
106 
107  call mmhcor(fid,mname,med_no_dt,med_no_it,med_full_interlace,ncoord,cret)
108  if (cret .ne. 0 ) then
109  print *,'Nodes coordinates'
110  call efexit(-1)
111  endif
112  print *,"Nodes coordinates =", ncoord
113  deallocate(ncoord)
114 
115  ! read number of geometrical types for cells
116  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,med_geo_all,med_connectivity,med_nodal,coocha,geotra,ngeo,cret)
117  if (cret .ne. 0 ) then
118  print *,'Read number of geometrical types for cells'
119  call efexit(-1)
120  endif
121  print *,"number of geometrical types for cells =", ngeo
122 
123  do igeo=1,ngeo
124 
125  print *,'mesh iterator =',imesh
126 
127  ! get geometry type
128  call mmheni(fid,mname,med_no_dt,med_no_it,med_cell,igeo,gtname,geotyp,cret)
129  if (cret .ne. 0 ) then
130  print *,'Read geometry type'
131  call efexit(-1)
132  endif
133  print *,"Geometry type =", geotyp
134 
135  ! how many cells of type geotype ?
136  call mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,geotyp,med_connectivity,med_nodal,coocha,geotra,nelt,cret)
137  if (cret .ne. 0 ) then
138  print *,'Read number of cells in the geotype'
139  call efexit(-1)
140  endif
141  print *,"number of cells in the geotype =", nelt
142 
143  ! read mesh nodes coordinates
144  allocate ( connectivity(nelt*4) ,stat=cret )
145  if (cret > 0) then
146  print *,'Memory allocation - connectivity'
147  call efexit(-1)
148  endif
149 
150  ! read cells connectivity in the mesh
151  call mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,geotyp,med_nodal,med_full_interlace,connectivity,cret)
152  if (cret .ne. 0 ) then
153  print *,'Connectivity'
154  call efexit(-1)
155  endif
156  print *,"Connectivity =", connectivity
157  deallocate(connectivity)
158 
159  enddo
160  enddo
161 
162  ! close file **
163  call mficlo(fid,cret)
164  if (cret .ne. 0 ) then
165  print *,'ERROR : close file'
166  call efexit(-1)
167  endif
168 
169 end program usescase_medmesh_3
170 
subroutine mficlo(fid, cret)
Definition: medfile.f:80
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
subroutine mmheni(fid, name, numdt, numit, entype, it, geoname, geotype, cret)
Definition: medmesh.f:1229
subroutine mmhmii(fid, it, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Definition: medmesh.f:110
program usescase_medmesh_3
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
subroutine mmhnmh(fid, n, cret)
Definition: medmesh.f:41
subroutine mmhnax(fid, it, naxis, cret)
Definition: medmesh.f:64