MED fichier: usecases/f/UsesCase_MEDmesh_10.f

MED fichier

usecases/f/UsesCase_MEDmesh_10.f
1 C* This file is part of MED.
2 C*
3 C* COPYRIGHT (C) 1999 - 2023 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*8 fid
32
33 C space dim, mesh dim
34 integer sdim, mdim
35 C axis name, unit name
36 character*16 axname(2), unname(2)
37 C mesh name, family name, time step unit, file name
38 character*64 mname, fyname, dtunit, finame
39 C mesh type, sorting type, grid type
40 integer mtype, stype, grtype
41 C family number, number of group
42 integer fnum, ngro
43 C group name
44 character*80 gname
45 C coordinates, date
46 real*8 coords(30), dt
47 integer nnodes, ntria3, nquad4
48 C triangular and quadrangular cells connectivity
49 integer tricon(24), quacon(16)
50 C family numbers
51 integer fanbrs(15)
52 C comment 1, mesh description
53 character*200 cmt1, mdesc
54 C
55 parameter(sdim = 2, mdim = 2)
56 parameter(mname = "2D unstructured mesh")
57 parameter(fyname = "BOUNDARY_VERTICES")
58 parameter(dtunit = " ")
59 parameter(dt = 0.0d0)
60 parameter(finame = "UsesCase_MEDmesh_10.med")
61 parameter(gname = "MESH_BOUNDARY_VERTICES")
62 parameter(nnodes = 15, ntria3 = 8, nquad4 = 4)
63 parameter(cmt1 ="A 2D unstructured mesh : 15 nodes, 12 cells")
64 parameter(mtype=med_unstructured_mesh, stype=med_sort_dtit )
65 parameter(mdesc = "A 2D unstructured mesh")
66 parameter(grtype=med_cartesian_grid)
67 C
68 data axname /"x" ,"y" /
69 data unname /"cm","cm"/
70 data coords /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
71 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
72 & 2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
73 data tricon /1,7,6, 2,7,1, 3,7,2, 8,7,3,
74 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
75 data quacon /3,4,9,8, 4,5,10,9,
76 & 15,14,9,10, 13,8,9,14/
77 data fanbrs /1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1/
78 C
79 C
80 C file creation
81 call mfiope(fid,finame,med_acc_creat,cret)
82 if (cret .ne. 0 ) then
83 print *,'ERROR : file creation'
84 call efexit(-1)
85 endif
86 C
87 C
88 C write a comment in the file
89 call mficow(fid,cmt1,cret)
90 if (cret .ne. 0 ) then
91 print *,'ERROR : write file description'
92 call efexit(-1)
93 endif
94 C
95 C
96 C mesh creation : a 2D unstructured mesh
97 call mmhcre(fid, mname, sdim, mdim, mtype, mdesc, dtunit,
98 & stype, grtype, axname, unname, cret)
99 if (cret .ne. 0 ) then
100 print *,'ERROR : mesh creation'
101 call efexit(-1)
102 endif
103 C
104 C
105 C nodes coordinates in a cartesian axis in full interlace mode
106 C (X1,Y1, X2,Y2, X3,Y3, ...) with no iteration and computation step
107 call mmhcow(fid,mname,med_no_dt,med_no_it,dt,
108 & med_full_interlace,nnodes,coords,cret)
109 if (cret .ne. 0 ) then
110 print *,'ERROR : write nodes coordinates description'
111 call efexit(-1)
112 endif
113 C
114 C
115 C cells connectiviy is defined in nodal mode
116 call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
117 & med_tria3,med_nodal,med_full_interlace,
118 & ntria3,tricon,cret)
119 if (cret .ne. 0 ) then
120 print *,'ERROR : triangular cells connectivity'
121 call efexit(-1)
122 endif
123 call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
124 & med_quad4,med_nodal,med_full_interlace,
125 & nquad4,quacon,cret)
126 if (cret .ne. 0 ) then
127 print *,'ERROR : quadrangular cells connectivity'
128 call efexit(-1)
129 endif
130 C
131 C
132 C create family 0 : by default, all mesh entities family number is 0
133 call mfacre(fid,mname,med_no_name,0,0,med_no_group,cret)
134 if (cret .ne. 0 ) then
135 print *,'ERROR : create family 0'
136 call efexit(-1)
137 endif
138 C
139 C
140 C create a family for boundary vertices : by convention a nodes family number is > 0,
141 C and an element family number is < 0
142 fnum = 1
143 ngro = 1
144 call mfacre(fid, mname, fyname, fnum, ngro, gname, cret)
145 if (cret .ne. 0 ) then
146 print *,'ERROR : create family 0'
147 call efexit(-1)
148 endif
149 C
150 C
151 C write family number for nodes
152 call mmhfnw(fid, mname, med_no_dt, med_no_it, med_node, med_none,
153 & nnodes, fanbrs, cret)
154 if (cret .ne. 0 ) then
155 print *,'ERROR : nodes family numbers ...'
156 call efexit(-1)
157 endif
158 C
159 C
160 C close file
161 call mficlo(fid,cret)
162 if (cret .ne. 0 ) then
163 print *,'ERROR : close file'
164 call efexit(-1)
165 endif
166 C
167 C
168 C
169 end
170 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:466
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:578
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
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:99
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
usescase_medmesh_10
program usescase_medmesh_10
Definition: UsesCase_MEDmesh_10.f:24
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
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,...
Definition: medmesh.f:299
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42