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' subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
program usescase_medmesh_10
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mficlo(fid, cret)
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mficow(fid, cmt, cret)
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)