MED fichier
UsesCase_MEDmesh_1.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 1 : a 2D unstructured mesh with 15 nodes,
21 C * 8 triangular cells, 4 quadrangular cells
22 C *
23 C *****************************************************************************
25 C
26  implicit none
27  include 'med.hf77'
28 C
29 C
30 C
31  integer cret
32  integer fid
33  integer sdim, mdim, stype, mtype, atype, nnode
34  integer ntria, nquad
35  integer fnum, ngro
36  character*200 cmt1,mdesc
37  character*64 fname
38  character*64 mname
39  character*16 nomcoo(2)
40  character*16 unicoo(2)
41  character*16 dtunit
42  real*8 dt
43  parameter(fname = "UsesCase_MEDmesh_1.med")
44  parameter(mdesc = "A 2D unstructured mesh")
45  parameter(cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
46  parameter(mname = "2D unstructured mesh")
47  parameter(sdim = 2, mdim = 2, nnode=15)
48  parameter(stype=med_sort_dtit, mtype=med_unstructured_mesh)
49  parameter(atype=med_cartesian)
50  parameter(dt=0.0d0)
51  parameter(ntria = 8, nquad = 4)
52  parameter(fnum = 0, ngro = 0)
53  data dtunit /" "/
54  data nomcoo /"x" ,"y" /
55  data unicoo /"cm","cm"/
56  real*8 coo(30)
57  data coo /2.,1.,7.,1.,12.,1.,17.,1.,22.,1.,
58  & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
59  & 2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
60  integer tricon(24)
61  data tricon /1,7,6, 2,7,1, 3,7,2, 8,7,3,
62  & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
63  integer quacon(16)
64  data quacon /3,4,9,8, 4,5,10,9,
65  & 15,14,9,10, 13,8,9,14 /
66 C
67 C
68 C file creation
69  call mfiope(fid,fname,med_acc_creat,cret)
70  if (cret .ne. 0 ) then
71  print *,'ERROR : file creation'
72  call efexit(-1)
73  endif
74 C
75 C
76 C write a comment in the file
77  call mficow(fid,cmt1,cret)
78  if (cret .ne. 0 ) then
79  print *,'ERROR : write file description'
80  call efexit(-1)
81  endif
82 C
83 C
84 C mesh creation
85  call mmhcre(fid, mname, sdim, mdim, mtype,mdesc,
86  & dtunit, stype, atype, nomcoo, unicoo, cret)
87  if (cret .ne. 0 ) then
88  print *,'ERROR : mesh creation'
89  call efexit(-1)
90  endif
91 C
92 C
93 C write nodes coordinates
94  call mmhcow(fid,mname,med_no_dt,med_no_it,dt,
95  & med_full_interlace,nnode,coo,cret)
96  if (cret .ne. 0 ) then
97  print *,'ERROR : write nodes coordinates description'
98  call efexit(-1)
99  endif
100 C
101 C
102 C cells connectiviy is defined in nodal mode with
103 C no iteration and computation step
104  call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
105  & med_tria3,med_nodal,med_full_interlace,
106  & ntria,tricon,cret)
107  print *,cret
108  if (cret .ne. 0 ) then
109  print *,'ERROR : triangular cells connectivity'
110  call efexit(-1)
111  endif
112 C
113  call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
114  & med_quad4,med_nodal,med_full_interlace,
115  & nquad,quacon,cret)
116  print *,cret
117  if (cret .ne. 0 ) then
118  print *,'ERROR : quadrangular cells connectivity'
119  call efexit(-1)
120  endif
121 C
122 C
123 C create family 0 : by default, all mesh entities family number is 0
124  call mfacre(fid,mname,med_no_name,fnum,ngro,med_no_group,cret)
125  print *,cret
126  if (cret .ne. 0 ) then
127  print *,'ERROR : family 0 creation'
128  call efexit(-1)
129  endif
130 C
131 C
132 C close file
133  call mficlo(fid,cret)
134  if (cret .ne. 0 ) then
135  print *,'ERROR : close file'
136  call efexit(-1)
137  endif
138 C
139 C
140 C
141  end
142 C
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_1
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