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