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 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 mmhcpw(fid, name, numdt, numit, dt, stm, pname, swm, dim, 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 et un profil donnés.
program usescase_medmesh_9
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 mmhypw(fid, name, numdt, numit, dt, entype, geotype, cmode, stmode, pname, swm, dim, 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 mmhtfw(fid, name, numdt, numit, dt, tsf, cret)
Cette routine définit les paramètres de translation rotation à appliquer aux noeuds de la séquence de...