MED fichier: Fichier source de UsesCase_MEDmesh_3.f90

MED fichier

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

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