MED fichier: Fichier source de UsesCase_MEDmesh_13.f

MED fichier

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

UsesCase_MEDmesh_13.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*
20 C* Use case 13 : a 2D unstructured mesh with 10 nodes and 2 polygons
21 C*
22 C* poly1 : 1,4,7,9,6,3
23 C* poly2 : 2,5,8,10,7,4
24 C
25 C* 9 10
26 C*
27 C* 6 7 8
28 C*
29 C* 3 4 5
30 C*
31 C* 1 2
32 C*
33 C *****************************************************************************
34 program usescase_medmesh_13
35 C
36 implicit none
37 include 'med.hf77'
38 C
39 C
40 integer cret
41 integer fid
42 C space dim, mesh dim
43 integer sdim, mdim
44 C axis name, unit name
45 character*16 axname(2), unname(2)
46 C mesh name, file name
47 character*64 mname, finame
48 character*64 dtunit
49 C coordinates
50 real*8 coords(2*10)
51 integer nnodes
52 integer isize
53 integer index(3)
54 integer conity(12)
55 C comment 1, mesh description
56 character*200 cmt1, mdesc
57 C
58 parameter(sdim = 2, mdim = 2)
59 parameter(mname = "2D unstructured mesh")
60 parameter(dtunit = "")
61 parameter(finame = "UsesCase_MEDmesh_13.med")
62 C Dix noeuds dont deux communs aux deux polygones */
63 parameter(nnodes = 10)
64 parameter(isize = 3)
65 parameter(cmt1 ="A 2D unstructured mesh : 10 nodes, 2 polygons")
66 parameter(mdesc = "A 2D mesh with 2 polygons")
67 C
68 data axname /"x ","y "/
69 data unname /"cm ","cm "/
70 data coords / 0.5, 0.,
71 & 1.5, 0.,
72 & 0., 0.5,
73 & 1., 0.5,
74 & 2., 0.5,
75 & 0., 1.,
76 & 1., 1.,
77 & 2., 1.,
78 & 0.5, 2.,
79 & 1.5, 2. /
80 data index / 1, 7, 13 /
81 data conity / 1,4,7,9,6,3,
82 & 2,5,8,10,7,4 /
83 C
84 C
85 C file creation
86 call mfiope(fid,finame,med_acc_creat,cret)
87 if (cret .ne. 0 ) then
88 print *,'ERROR : file creation'
89 call efexit(-1)
90 endif
91 C
92 C
93 C write a comment in the file
94 call mficow(fid,cmt1,cret)
95 if (cret .ne. 0 ) then
96 print *,'ERROR : write file description'
97 call efexit(-1)
98 endif
99 C
100 C
101 C mesh creation : a 2D unstructured mesh
102 call mmhcre(fid, mname, sdim, mdim, med_unstructured_mesh, mdesc,
103 & dtunit, med_sort_dtit, med_cartesian,
104 & axname, unname, cret)
105 if (cret .ne. 0 ) then
106 print *,'ERROR : mesh creation'
107 call efexit(-1)
108 endif
109 C
110 C
111 C nodes coordinates in a cartesian axis in full interlace mode
112 C (X1,Y1, X2,Y2, X3,Y3, ...) with no iteration and computation step
113 call mmhcow(fid,mname,med_no_dt,med_no_it, med_undef_dt,
114 & med_full_interlace,nnodes,coords,cret)
115 if (cret .ne. 0 ) then
116 print *,'ERROR : write nodes coordinates description'
117 call efexit(-1)
118 endif
119 C
120 C
121 C cells connectiviy is defined in nodal mode
122 C 2 polygons
123 call mmhpgw(fid, mname, med_no_dt, med_no_it, med_undef_dt,
124 & med_cell, med_nodal, isize, index, conity, cret)
125 if (cret .ne. 0 ) then
126 print *,'ERROR : polygon 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 close file
140 call mficlo(fid,cret)
141 if (cret .ne. 0 ) then
142 print *,'ERROR : close file'
143 call efexit(-1)
144 endif
145 C
146 C
147 C
148 end
149 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
usescase_medmesh_13
program usescase_medmesh_13
Definition: UsesCase_MEDmesh_13.f:34
mmhpgw
subroutine mmhpgw(fid, name, numdt, numit, dt, entype, cmode, isize, index, con, cret)
Cette routine permet l'écriture des connectivités de polygones.
Definition: medmesh.f:850
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
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