1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
35
36 implicit none
37 include 'med.hf77'
38
39
40 integer cret
41 integer*8 fid
42
43
44 integer sdim, mdim
45
46 character*16 axname(2), unname(2)
47
48 character*64 mname, finame
49 character*64 dtunit
50
51 real*8 coords(2*10)
52 integer nnodes
53 integer isize
54 integer index(3)
55 integer conity(12)
56
57 character*200 cmt1, mdesc
58
59 parameter(sdim = 2, mdim = 2)
60 parameter(mname = "2D unstructured mesh")
61 parameter(dtunit = "")
62 parameter(finame = "UsesCase_MEDmesh_13.med")
63
64 parameter(nnodes = 10)
65 parameter(isize = 3)
66 parameter(cmt1 ="A 2D unstructured mesh : 10 nodes, 2 polygons")
67 parameter(mdesc = "A 2D mesh with 2 polygons")
68
69 data axname /"x ","y "/
70 data unname /"cm ","cm "/
71 data coords / 0.5, 0.,
72 & 1.5, 0.,
73 & 0., 0.5,
74 & 1., 0.5,
75 & 2., 0.5,
76 & 0., 1.,
77 & 1., 1.,
78 & 2., 1.,
79 & 0.5, 2.,
80 & 1.5, 2. /
81 data index / 1, 7, 13 /
82 data conity / 1,4,7,9,6,3,
83 & 2,5,8,10,7,4 /
84
85
86
87 call mfiope(fid,finame,med_acc_creat,cret)
88 if (cret .ne. 0 ) then
89 print *,'ERROR : file creation'
90 call efexit(-1)
91 endif
92
93
94
96 if (cret .ne. 0 ) then
97 print *,'ERROR : write file description'
98 call efexit(-1)
99 endif
100
101
102
103 call mmhcre(fid, mname, sdim, mdim, med_unstructured_mesh, mdesc,
104 & dtunit, med_sort_dtit, med_cartesian,
105 & axname, unname, cret)
106 if (cret .ne. 0 ) then
107 print *,'ERROR : mesh creation'
108 call efexit(-1)
109 endif
110
111
112
113
114 call mmhcow(fid,mname,med_no_dt,med_no_it, med_undef_dt,
115 & med_full_interlace,nnodes,coords,cret)
116 if (cret .ne. 0 ) then
117 print *,'ERROR : write nodes coordinates description'
118 call efexit(-1)
119 endif
120
121
122
123
124 call mmhpgw(fid, mname, med_no_dt, med_no_it, med_undef_dt,
125 & med_cell, med_nodal, isize, index, conity, cret)
126 if (cret .ne. 0 ) then
127 print *,'ERROR : polygon connectivity ...'
128 call efexit(-1)
129 endif
130
131
132
133 call mfacre(fid,mname,med_no_name,0,0,med_no_group,cret)
134 if (cret .ne. 0 ) then
135 print *,'ERROR : create family 0'
136 call efexit(-1)
137 endif
138
139
140
142 if (cret .ne. 0 ) then
143 print *,'ERROR : close file'
144 call efexit(-1)
145 endif
146
147
148
149 end
150
program usescase_medmesh_13
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficow(fid, cmt, cret)
subroutine mficlo(fid, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mmhpgw(fid, name, numdt, numit, dt, entype, cmode, isize, index, con, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)