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