1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
25
26 implicit none
27 include 'med.hf77'
28
29
30
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
68
69
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
76
77
79 if (cret .ne. 0 ) then
80 print *,'ERROR : write file description'
81 call efexit(-1)
82 endif
83
84
85
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
93
94
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
102
103
104
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
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
123
124
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
132
133
135 if (cret .ne. 0 ) then
136 print *,'ERROR : close file'
137 call efexit(-1)
138 endif
139
140
141
142 end
143
program usescase_medmesh_1
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 mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)