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