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' subroutine mficlo(fid, cret)
subroutine mficow(fid, cmt, cret)
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, 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 mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
subroutine mfiope(fid, name, access, cret)
program usescase_medmesh_10