MED fichier: Fichier source de UsesCase_MEDmesh_14.f90

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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