30 integer cret,mdim, sdim
31 parameter(mdim = 3, sdim = 3)
38 integer indexp(np),indexf(nf)
42 parameter(nf2=8,np2=3)
43 integer indexp2(np2),indexf2(nf2)
49 character*16 nomcoo(3)
50 character*16 unicoo(3)
53 data indexf / 1,4,7,10,13,16,19,22,25 /
54 data conn / 1,2,3,4,5,6,7,8,9,10,11,12,13,14,
55 & 15,16,17,18,19,20,21,22,23,24 /
56 data indexp2 / 1,5,9 /
57 data indexf2 / med_tria3,med_tria3,med_tria3,med_tria3,
58 & med_tria3,med_tria3,med_tria3,med_tria3 /
59 data conn2 / 1,2,3,4,5,6,7,8 /
60 data nom /
"poly1",
"poly2"/
61 data num / 1,2 /, fam / 0,-1 /
63 data nomcoo /
"x",
"y",
"z"/, unicoo /
"cm",
"cm",
"cm"/
66 call mfiope(fid,
'test25.med',med_acc_rdwr, cret)
68 if (cret .ne. 0 )
then
69 print *,
'Erreur creation du fichier'
72 print *,
'Creation du fichier test25.med'
75 call mmhcre(fid,maa,mdim,sdim,
76 & med_unstructured_mesh,
'un maillage pour test 25',
77 &
"",med_sort_dtit,med_cartesian,nomcoo,unicoo,cret)
78 if (cret .ne. 0 )
then
79 print *,
'Erreur creation du maillage'
83 print *,
'Creation du maillage'
86 call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
87 & med_nodal,np,indexp,nf,indexf,conn,cret)
89 if (cret .ne. 0 )
then
90 print *,
'Erreur ecriture connectivite des polyedres'
93 print *,
'Ecriture des connectivites des mailles
94 & de type MED_POLYEDRE'
95 print *,
'Description nodale'
98 call mmhphw(fid,maa,med_no_dt,med_no_it,med_undef_dt,med_cell,
99 & med_descending,np2,indexp2,nf2,indexf2,conn2,cret)
101 if (cret .ne. 0 )
then
102 print *,
'Erreur ecriture connectivite des polyedres'
105 print *,
'Ecriture des connectivites des mailles
106 & de type MED_POLYEDRE'
107 print *,
'Description descendante'
110 call mmheaw(fid,maa,med_no_dt,med_no_it,med_cell,
111 & med_polyhedron,n,nom,cret)
113 if (cret .ne. 0 )
then
114 print *,
'Erreur ecriture noms des polyedres'
117 print *,
'Ecriture des noms des polyedress'
120 call mmhenw(fid,maa,med_no_dt,med_no_it,med_cell,
121 & med_polyhedron,n,num,cret)
123 if (cret .ne. 0 )
then
124 print *,
'Erreur ecriture numeros des polyedres'
127 print *,
'Ecriture des numeros des polyedres'
130 call mmhfnw(fid,maa,med_no_dt,med_no_it,med_cell,
131 & med_polyhedron,n,fam,cret)
133 if (cret .ne. 0 )
then
134 print *,
'Erreur ecriture numeros de familles polyedres'
137 print *,
'Ecriture des numeros de familles des polyedres'
142 if (cret .ne. 0 )
then
143 print *,
'Erreur fermeture du fichier'
146 print *,
'Fermeture du fichier'
subroutine mmheaw(fid, mname, numdt, numit, entype, geotype, n, ename, cret)
subroutine mmhphw(fid, name, numdt, numit, dt, entype, cmode, fisize, findex, nisize, nindex, con, cret)
subroutine mfiope(fid, name, access, cret)
subroutine mmhenw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhfnw(fid, name, numdt, numit, entype, geotype, n, num, cret)
subroutine mmhcre(fid, name, sdim, mdim, mtype, desc, dtunit, stype, atype, aname, aunit, cret)
subroutine mficlo(fid, cret)