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