MED fichier: Fichier source de UsesCase_MEDmesh_1.f

MED fichier

- Documentation MED
- Guides d'utilisation
- Guides de référence

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 *****************************************************************************
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 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
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
mficlo
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
Definition: medfile.f:80
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:96
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
usescase_medmesh_1
program usescase_medmesh_1
Definition: UsesCase_MEDmesh_1.f:24
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:551
mfiope
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
Definition: medfile.f:41
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, selon une séquence de calcul donnée.
Definition: medmesh.f:285