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 mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
Cette routine permet l'écriture des numéros de famille d'un type d'entité d'un maillage.
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 mficlo(fid, cret)
Fermeture d'un fichier MED.
subroutine mficow(fid, cmt, cret)
Ecriture d'un descripteur dans 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.
program usescase_medmesh_10
subroutine mmhcyw(fid, name, numdt, numit, dt, entype, geotype, cmode, swm, n, con, cret)
Cette routine permet d'écrire dans un maillage le tableau des connectivités pour un type géométrique ...
subroutine mfiope(fid, name, access, cret)
Ouverture d'un fichier MED.
subroutine mmhcow(fid, name, numdt, numit, dt, swm, n, coo, cret)
Cette routine permet d'écrire dans un maillage le tableau des coordonnées des noeuds, selon une séquence de calcul donnée.