MED fichier: Fichier source de UsesCase_MEDmesh_1.f

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 - 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 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
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
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: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
mficow
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
Definition: medfile.f:99