MED fichier: Fichier source de UsesCase_MEDmesh_2.f90

MED fichier

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

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
24 program usescase_medmesh_2
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
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Definition: medmesh.f:320
usescase_medmesh_2
program usescase_medmesh_2
Definition: UsesCase_MEDmesh_2.f90:24
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Definition: medmesh.f:551
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Definition: medmesh.f:600
mmhnan
subroutine mmhnan(fid, name, naxis, cret)
Definition: medmesh.f:86
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
mficlo
subroutine mficlo(fid, cret)
Definition: medfile.f:82