MED fichier
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 - 2021 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 *****************************************************************************
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:82
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
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
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:42
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
usescase_medmesh_10
program usescase_medmesh_10
Definition: UsesCase_MEDmesh_10.f:24
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:99
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