36 character*16 axname(2), unname(2)
38 character*64 mname, fyname, dtunit, finame
40 integer mtype, stype, grtype
47 integer nnodes, ntria3, nquad4
49 integer tricon(24), quacon(16)
53 character*200 cmt1, mdesc
55 parameter(sdim = 2, mdim = 2)
56 parameter(mname =
"2D unstructured mesh")
57 parameter(fyname =
"BOUNDARY_VERTICES")
58 parameter(dtunit =
" ")
60 parameter(finame =
"UsesCase_MEDmesh_10.med")
61 parameter(gname =
"MESH_BOUNDARY_VERTICES")
62 parameter(nnodes = 15, ntria3 = 8, nquad4 = 4)
63 parameter(cmt1 =
"A 2D unstructured mesh : 15 nodes, 12 cells")
64 parameter(mtype=med_unstructured_mesh, stype=med_sort_dtit )
65 parameter(mdesc =
"A 2D unstructured mesh")
66 parameter(grtype=med_cartesian_grid)
68 data axname /
"x" ,
"y" /
69 data unname /
"cm",
"cm"/
70 data coords /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
71 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
72 & 2.,11., 7.,11., 12.,11., 17.,11., 22.,11./
73 data tricon /1,7,6, 2,7,1, 3,7,2, 8,7,3,
74 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
75 data quacon /3,4,9,8, 4,5,10,9,
76 & 15,14,9,10, 13,8,9,14/
77 data fanbrs /1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 1, 1/
81 call mfiope(fid,finame,med_acc_creat,cret)
82 if (cret .ne. 0 )
then
83 print *,
'ERROR : file creation'
90 if (cret .ne. 0 )
then
91 print *,
'ERROR : write file description'
97 call mmhcre(fid, mname, sdim, mdim, mtype, mdesc, dtunit,
98 & stype, grtype, axname, unname, cret)
99 if (cret .ne. 0 )
then
100 print *,
'ERROR : mesh creation'
107 call mmhcow(fid,mname,med_no_dt,med_no_it,dt,
108 & med_full_interlace,nnodes,coords,cret)
109 if (cret .ne. 0 )
then
110 print *,
'ERROR : write nodes coordinates description'
116 call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
117 & med_tria3,med_nodal,med_full_interlace,
118 & ntria3,tricon,cret)
119 if (cret .ne. 0 )
then
120 print *,
'ERROR : triangular cells connectivity'
123 call mmhcyw(fid,mname,med_no_dt,med_no_it,dt,med_cell,
124 & med_quad4,med_nodal,med_full_interlace,
125 & nquad4,quacon,cret)
126 if (cret .ne. 0 )
then
127 print *,
'ERROR : quadrangular cells connectivity'
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'
144 call mfacre(fid, mname, fyname, fnum, ngro, gname, cret)
145 if (cret .ne. 0 )
then
146 print *,
'ERROR : create family 0'
152 call mmhfnw(fid, mname, med_no_dt, med_no_it, med_node, med_none,
153 & nnodes, fanbrs, cret)
154 if (cret .ne. 0 )
then
155 print *,
'ERROR : nodes family numbers ...'
162 if (cret .ne. 0 )
then
163 print *,
'ERROR : close file'