35 character (MED_NAME_SIZE) mname
36 character (MED_NAME_SIZE) fname
37 character (MED_COMMENT_SIZE) cmt1,mdesc
40 character (MED_SNAME_SIZE) axname(2)
42 character (MED_SNAME_SIZE) unname(2)
44 integer nnodes, ntria3, nquad4
54 parameter(fname =
"UsesCase_MEDmesh_9.med")
55 parameter(cmt1 =
"A 2D unstructured mesh : 15 nodes, 12 cells")
56 parameter(mdesc =
"A 2D unstructured mesh")
57 parameter(mname=
"2D unstructured mesh")
58 parameter(sdim=2, mdim=2)
59 parameter(nnodes=15,ntria3=8,nquad4=4)
61 data axname /
"x",
"y"/
62 data unname /
"cm",
"cm"/
63 data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
64 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
65 & 2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
66 data triacy /1,7,6, 2,7,1, 3,7,2, 8,7,3,
67 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
68 data quadcy /3,4,9,8, 4,5,10,9,
69 & 15,14,9,10, 13,8,9,14/
71 data trama1 /0.0, 0.0, 0.0, 0.92388, 0.0, 0.38268, 0.0/
73 data trama2 /0.0, 0.0, 0.0, 0.707, 0.0, 0.707, 0.0/
76 call mfiope(fid,fname,med_acc_creat,cret)
77 if (cret .ne. 0 )
then 78 print *,
"ERROR : file creation" 84 if (cret .ne. 0 )
then 85 print *,
"ERROR : write file description" 90 call mmhcre(fid, mname, sdim, mdim, med_unstructured_mesh, mdesc,
91 &
"", med_sort_dtit, med_cartesian, axname, unname, cret)
92 if (cret .ne. 0 )
then 93 print *,
"ERROR : mesh creation" 100 call mmhcpw(fid, mname, med_no_dt, med_no_it, 0.0d0,
101 & med_compact_stmode, med_no_profile,
102 & med_full_interlace, med_all_constituent,
103 & nnodes, inicoo, cret)
104 if (cret .ne. 0 )
then 105 print *,
"ERROR : nodes coordinates" 111 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
112 & med_cell, med_tria3, med_nodal,
113 & med_compact_stmode, med_no_profile,
114 & med_full_interlace, med_all_constituent,
115 & ntria3, triacy, cret)
116 if (cret .ne. 0 )
then 117 print *,
"ERROR : triangular cells connectivity" 122 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
123 & med_cell, med_quad4, med_nodal,
124 & med_compact_stmode, med_no_profile,
125 & med_full_interlace, med_all_constituent,
126 & nquad4, quadcy, cret)
127 if (cret .ne. 0 )
then 128 print *,
"ERROR : quadrangular cells connectivity" 137 call mmhtfw(fid, mname, 1, 1, 5.5d0, trama1, cret)
141 call mmhtfw(fid, mname, 2, 1, 8.9d0, trama2, cret)
145 call mfacre(fid, mname,med_no_name, 0, 0, med_no_group, cret)
146 if (cret .ne. 0 )
then 147 print *,
"ERROR : create family 0" 154 if (cret .ne. 0 )
then 155 print *,
"ERROR : close file" subroutine mmhtfw(fid, name, numdt, numit, dt, tsf, cret)
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhypw(fid, name, numdt, numit, dt, entype, geotype, cmode, stmode, pname, swm, dim, n, con, cret)
subroutine mmhcpw(fid, name, numdt, numit, dt, stm, pname, swm, dim, n, coo, cret)
program usescase_medmesh_9
subroutine mficow(fid, cmt, cret)
subroutine mficlo(fid, cret)