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
51 character (MED_NAME_SIZE) prof1n
59 character (MED_NAME_SIZE) prof2n
65 parameter(fname =
"UsesCase_MEDmesh_6.med")
66 parameter(cmt1 =
"A 2D unstructured mesh : 15 nodes, 12 cells")
67 parameter(mdesc =
"A 2D unstructured mesh")
68 parameter(mname=
"2D unstructured mesh")
69 parameter(sdim=2, mdim=2)
70 parameter(nnodes=15,ntria3=8,nquad4=4)
72 data axname /
"x",
"y"/
73 data unname /
"cm",
"cm"/
74 data inicoo /2.,1., 7.,1., 12.,1., 17.,1., 22.,1.,
75 & 2.,6., 7.,6., 12.,6., 17.,6., 22.,6.,
76 & 2.,11.,7.,11.,12.,11.,17.,11., 22.,11./
77 data triacy /1,7,6, 2,7,1, 3,7,2, 8,7,3,
78 & 13,7,8, 12,7,13, 11,7,12, 6,7,11/
79 data quadcy /3,4,9,8, 4,5,10,9,
80 & 15,14,9,10, 13,8,9,14/
83 data nwcos1 /12.,15., 17.,15., 22.,15./
84 parameter(prof1n=
"UPPER_QUAD4_PROFILE")
85 data profi1 /13, 14, 15/
89 data nwcos2 /12.,10., 17.,10., 22.,10./
90 parameter(prof2n=
"MIDDLE_QUAD4_PROFILE")
91 data profi2 /8, 9, 10/
95 call mfiope(fid,fname,med_acc_creat,cret)
96 if (cret .ne. 0 )
then
97 print *,
"ERROR : file creation"
102 call mficow(fid,cmt1,cret)
103 if (cret .ne. 0 )
then
104 print *,
"ERROR : write file description"
109 call mpfprw(fid,prof1n,pro1sz,profi1,cret)
110 if (cret .ne. 0 )
then
111 print *,
"ERROR : create profile"
116 call mpfprw(fid,prof2n,pro2sz,profi2,cret)
117 if (cret .ne. 0 )
then
118 print *,
"ERROR : create profile"
123 call mmhcre(fid, mname, sdim, mdim, med_unstructured_mesh, mdesc,
124 &
"", med_sort_dtit, med_cartesian, axname, unname, cret)
125 if (cret .ne. 0 )
then
126 print *,
"ERROR : mesh creation"
133 call mmhcpw(fid, mname, med_no_dt, med_no_it, 0.0d0,
134 & med_compact_stmode, med_no_profile,
135 & med_full_interlace, med_all_constituent,
136 & nnodes, inicoo, cret)
137 if (cret .ne. 0 )
then
138 print *,
"ERROR : nodes coordinates"
144 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
145 & med_cell, med_tria3, med_nodal,
146 & med_compact_stmode, med_no_profile,
147 & med_full_interlace, med_all_constituent,
148 & ntria3, triacy, cret)
149 if (cret .ne. 0 )
then
150 print *,
"ERROR : triangular cells connectivity"
155 call mmhypw(fid, mname, med_no_dt, med_no_it, 0.0d0,
156 & med_cell, med_quad4, med_nodal,
157 & med_compact_stmode, med_no_profile,
158 & med_full_interlace, med_all_constituent,
159 & nquad4, quadcy, cret)
160 if (cret .ne. 0 )
then
161 print *,
"ERROR : quadrangular cells connectivity"
170 call mmhcpw(fid, mname, 1, 1, 5.5d0,
171 & med_compact_stmode, prof1n,
172 & med_full_interlace, med_all_constituent,
173 & nnodes, nwcos1, cret)
174 if (cret .ne. 0 )
then
175 print *,
"ERROR : nodes coordinates"
181 call mmhcpw(fid, mname, 2, 1, 8.9d0,
182 & med_compact_stmode, prof2n,
183 & med_full_interlace, med_all_constituent,
184 & nnodes, nwcos2, cret)
185 if (cret .ne. 0 )
then
186 print *,
"ERROR : nodes coordinates"
192 call mfacre(fid, mname,med_no_name, 0, 0, med_no_group, cret)
193 if (cret .ne. 0 )
then
194 print *,
"ERROR : create family 0"
201 if (cret .ne. 0 )
then
202 print *,
"ERROR : close file"
subroutine mpfprw(fid, pname, psize, profil, cret)
Cette routine permet d'écrire un profil dans un fichier MED.
program usescase_medmesh_6
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.
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.