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"
program usescase_medmesh_9
subroutine mfacre(fid, name, fname, fnum, ngro, gname, cret)
Cette routine permet la création d'une famille portant sur les entités d'un maillage.
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans un fichier MED.
subroutine mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
Cette routine permet de créer un maillage dans un fichier.
subroutine mmhcpw(fid, name, numdt, numit, dt, stm, pname, swm, dim, n, coo, cret)
subroutine mmhtfw(fid, name, numdt, numit, dt, tsf, cret)
subroutine mmhypw(fid, name, numdt, numit, dt, entype, geotype, cmode, stmode, pname, swm, dim, n, con, cret)