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