MED fichier: Fichier source de UsesCase_MEDmesh_10.f

MED fichier

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

UsesCase_MEDmesh_10.f
Aller à la documentation de ce fichier.
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2017 EDF R&D, CEA/DEN
4 C* MED is free software: you can redistribute it and/or modify
5 C* it under the terms of the GNU Lesser General Public License as published by
6 C* the Free Software Foundation, either version 3 of the License, or
7 C* (at your option) any later version.
8 C*
9 C* MED is distributed in the hope that it will be useful,
10 C* but WITHOUT ANY WARRANTY; without even the implied warranty of
11 C* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 C* GNU Lesser General Public License for more details.
13 C*
14 C* You should have received a copy of the GNU Lesser General Public License
15 C* along with MED. If not, see <http://www.gnu.org/licenses/>.
16 C*
17
18 C******************************************************************************
19 C * How to create an unstructured mesh
20 C * Use case 10 : write a 2D unstructured mesh with 15 nodes, 8 triangular
21 C * cells, 4 quadrangular cells, and families
22 C *
23 C *****************************************************************************
24 program usescase_medmesh_10
25 C
26 implicit none
27 include 'med.hf77'
28 C
29 C
30 integer cret
31 integer fid
32 C space dim, mesh dim
33 integer sdim, mdim
34 C axis name, unit name
35 character*16 axname(2), unname(2)
36 C mesh name, family name, time step unit, file name
37 character*64 mname, fyname, dtunit, finame
38 C mesh type, sorting type, grid type
39 integer mtype, stype, grtype
40 C family number, number of group
41 integer fnum, ngro
42 C group name
43 character*80 gname
44 C coordinates, date
45 real*8 coords(30), dt
46 integer nnodes, ntria3, nquad4
47 C triangular and quadrangular cells connectivity
48 integer tricon(24), quacon(16)
49 C family numbers
50 integer fanbrs(15)
51 C comment 1, mesh description
52 character*200 cmt1, mdesc
53 C
54 parameter(sdim = 2, mdim = 2)
55 parameter(mname = "2D unstructured mesh")
56 parameter(fyname = "BOUNDARY_VERTICES")
57 parameter(dtunit = " ")
58 parameter(dt = 0.0d0)
59 parameter(finame = "UsesCase_MEDmesh_10.med")
60 parameter(gname = "MESH_BOUNDARY_VERTICES")
61 parameter(nnodes = 15, ntria3 = 8, nquad4 = 4)
62 parameter(cmt1 ="A 2D unstructured mesh : 15 nodes, 12 cells")
63 parameter(mtype=med_unstructured_mesh, stype=med_sort_dtit )
64 parameter(mdesc = "A 2D unstructured mesh")
65 parameter(grtype=med_cartesian_grid)
66 C
67 data axname /"x" ,"y" /
68 data unname /"cm","cm"/
69 data coords /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
70 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
71 & 2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
72 data tricon /1,7,6, 2,7,1, 3,7,2, 8,7,3,
73 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
74 data quacon /3,4,9,8, 4,5,10,9,
75 & 15,14,9,10, 13,8,9,14/
76 data fanbrs /1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1/
77 C
78 C
79 C file creation
80 call mfiope(fid,finame,med_acc_creat,cret)
81 if (cret .ne. 0 ) then
82 print *,'ERROR : file creation'
83 call efexit(-1)
84 endif
85 C
86 C
87 C write a comment in the file
88 call mficow(fid,cmt1,cret)
89 if (cret .ne. 0 ) then
90 print *,'ERROR : write file description'
91 call efexit(-1)
92 endif
93 C
94 C
95 C mesh creation : a 2D unstructured mesh
96 call mmhcre(fid, mname, sdim, mdim, mtype, mdesc, dtunit,
97 & stype, grtype, axname, unname, cret)
98 if (cret .ne. 0 ) then
99 print *,'ERROR : mesh creation'
100 call efexit(-1)
101 endif
102 C
103 C
104 C nodes coordinates in a cartesian axis in full interlace mode
105 C (X1,Y1, X2,Y2, X3,Y3, ...) with no iteration and computation step
106 call mmhcow(fid,mname,med_no_dt,med_no_it,dt,
107 & med_full_interlace,nnodes,coords,cret)
108 if (cret .ne. 0 ) then
109 print *,'ERROR : write nodes coordinates description'
110 call efexit(-1)
111 endif
112 C
113 C
114 C cells connectiviy is defined in nodal mode
115 call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
116 & med_tria3,med_nodal,med_full_interlace,
117 & ntria3,tricon,cret)
118 if (cret .ne. 0 ) then
119 print *,'ERROR : triangular cells connectivity'
120 call efexit(-1)
121 endif
122 call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
123 & med_quad4,med_nodal,med_full_interlace,
124 & nquad4,quacon,cret)
125 if (cret .ne. 0 ) then
126 print *,'ERROR : quadrangular cells connectivity'
127 call efexit(-1)
128 endif
129 C
130 C
131 C create family 0 : by default, all mesh entities family number is 0
132 call mfacre(fid,mname,med_no_name,0,0,med_no_group,cret)
133 if (cret .ne. 0 ) then
134 print *,'ERROR : create family 0'
135 call efexit(-1)
136 endif
137 C
138 C
139 C create a family for boundary vertices : by convention a nodes family number is > 0,
140 C and an element family number is < 0
141 fnum = 1
142 ngro = 1
143 call mfacre(fid, mname, fyname, fnum, ngro, gname, cret)
144 if (cret .ne. 0 ) then
145 print *,'ERROR : create family 0'
146 call efexit(-1)
147 endif
148 C
149 C
150 C write family number for nodes
151 call mmhfnw(fid, mname, med_no_dt, med_no_it, med_node, med_none,
152 & nnodes, fanbrs, cret)
153 if (cret .ne. 0 ) then
154 print *,'ERROR : nodes family numbers ...'
155 call efexit(-1)
156 endif
157 C
158 C
159 C 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 C
166 C
167 C
168 end
169 C
mmhfnw
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet l'écriture des numéros de famille d'un type d'entité d'un maillage.
Definition: medmesh.f:444
mfacre
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
Cette routine permet la création d'une famille portant sur les entités d'un maillage.
Definition: medfamily.f:19
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:96
mmhcre
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
Cette routine permet de créer un maillage dans un fichier.
Definition: medmesh.f:20
usescase_medmesh_10
program usescase_medmesh_10
Definition: UsesCase_MEDmesh_10.f:24
mmhcyw
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
Definition: medmesh.f:551
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
mmhcow
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds, selon une séquence de calcul donnée.
Definition: medmesh.f:285