MED fichier: Fichier source de UsesCase_MEDmesh_2.f90

MED fichier

UsesCase_MEDmesh_2.f90
Aller à la documentation de ce fichier.
1 ! This file is part of MED.
2 !*
3 !* COPYRIGHT (C) 1999 - 2021 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
mmhnme
subroutine mmhnme(fid, name, numdt, numit, entype, geotype, datype, cmode, chgt, tsf, n, cret)
Cette routine permet de lire le nombre d'entités dans un maillage pour une étape de calcul donnée.
Definition: medmesh.f:551
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
mmhnan
subroutine mmhnan(fid, name, naxis, cret)
Cette routine permet de lire dans un maillage le nombre d'axes du repère des coordonnées des noeuds a...
Definition: medmesh.f:86
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
mmhcor
subroutine mmhcor(fid, name, numdt, numit, swm, coo, cret)
Cette routine permet de lire dans un maillage le tableau des coordonnées des noeuds,...
Definition: medmesh.f:320
usescase_medmesh_2
program usescase_medmesh_2
Definition: UsesCase_MEDmesh_2.f90:24
mmhmin
subroutine mmhmin(fid, name, sdim, mdim, mtype, desc, dtunit, stype, nstep, atype, aname, aunit, cret)
Cette routine permet de lire les informations relatives à un maillage en précisant son nom.
Definition: medmesh.f:130
mmhcyr
subroutine mmhcyr(fid, name, numdt, numit, entype, geotype, cmode, swm, con, cret)
Cette routine permet de lire dans un maillage le tableau des connectivités pour un type géométrique d...
Definition: medmesh.f:600