1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
26
27 implicit none
28 include 'med.hf77'
29
30
31 integer cret
32 integer*8 fid
33
34
35 character (MED_NAME_SIZE) mname
36 character (MED_NAME_SIZE) fname
37 character (MED_COMMENT_SIZE) cmt1,mdesc
38 integer sdim, mdim
39
40 character (MED_SNAME_SIZE) axname(2)
41
42 character (MED_SNAME_SIZE) unname(2)
43 real*8 inicoo(30)
44 integer nnodes, ntria3, nquad4
45
46 integer triacy(24)
47
48 integer quadcy(16)
49
50 real*8 trama1(7)
51
52 real*8 trama2(7)
53
54 parameter(fname = "UsesCase_MEDmesh_9.med")
55 parameter(cmt1 = "A 2D unstructured mesh : 15 nodes, 12 cells")
56 parameter(mdesc = "A 2D unstructured mesh")
57 parameter(mname="2D unstructured mesh")
58 parameter(sdim=2, mdim=2)
59 parameter(nnodes=15,ntria3=8,nquad4=4)
60
61 data axname /"x", "y"/
62 data unname /"cm", "cm"/
63 data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
64 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
65 & 2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
66 data triacy /1,7,6, 2,7,1, 3,7,2, 8,7,3,
67 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
68 data quadcy /3,4,9,8, 4,5,10,9,
69 & 15,14,9,10, 13,8,9,14/
70
71 data trama1 /0.0, 0.0, 0.0, 0.92388, 0.0, 0.38268, 0.0/
72
73 data trama2 /0.0, 0.0, 0.0, 0.707, 0.0, 0.707, 0.0/
74
75
76 call mfiope(fid,fname,med_acc_creat,cret)
77 if (cret .ne. 0 ) then
78 print *,"ERROR : file creation"
79 call efexit(-1)
80 endif
81
82
84 if (cret .ne. 0 ) then
85 print *,"ERROR : write file description"
86 call efexit(-1)
87 endif
88
89
90 call mmhcre(fid, mname, sdim, mdim, med_unstructured_mesh, mdesc,
91 & "", med_sort_dtit, med_cartesian, axname, unname, cret)
92 if (cret .ne. 0 ) then
93 print *,"ERROR : mesh creation"
94 call efexit(-1)
95 endif
96
97
98
99
100 call mmhcpw(fid, mname, med_no_dt, med_no_it, 0.0d0,
101 & med_compact_stmode, med_no_profile,
102 & med_full_interlace, med_all_constituent,
103 & nnodes, inicoo, cret)
104 if (cret .ne. 0 ) then
105 print *,"ERROR : nodes coordinates"
106 call efexit(-1)
107 endif
108
109
110
111 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
112 & med_cell, med_tria3, med_nodal,
113 & med_compact_stmode, med_no_profile,
114 & med_full_interlace, med_all_constituent,
115 & ntria3, triacy, cret)
116 if (cret .ne. 0 ) then
117 print *,"ERROR : triangular cells connectivity"
118 call efexit(-1)
119 endif
120
121
122 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
123 & med_cell, med_quad4, med_nodal,
124 & med_compact_stmode, med_no_profile,
125 & med_full_interlace, med_all_constituent,
126 & nquad4, quadcy, cret)
127 if (cret .ne. 0 ) then
128 print *,"ERROR : quadrangular cells connectivity"
129 call efexit(-1)
130 endif
131
132
133
134
135
136
137 call mmhtfw(fid, mname, 1, 1, 5.5d0, trama1, cret)
138
139
140
141 call mmhtfw(fid, mname, 2, 1, 8.9d0, trama2, cret)
142
143
144
145 call mfacre(fid, mname,med_no_name, 0, 0, med_no_group, cret)
146 if (cret .ne. 0 ) then
147 print *,"ERROR : create family 0"
148 call efexit(-1)
149 endif
150
151
152
154 if (cret .ne. 0 ) then
155 print *,"ERROR : close file"
156 call efexit(-1)
157 endif
158
159
160 end
161
program usescase_medmesh_9
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.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
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.
subroutine mmhcpw(fid, name, numdt, numit, dt, stm, pname, swm, dim, n, coo, cret)
subroutine mmhtfw(fid, name, numdt, numit, dt, tsf, cret)
subroutine mmhypw(fid, name, numdt, numit, dt, entype, geotype, cmode, stmode, pname, swm, dim, n, con, cret)